MODULE sbcdta_ice !!====================================================================== !! *** MODULE sbcdta_ice *** !! Emulate NEMOVAR by providing the RATE of change of ice concentration due !! to data assimilation from difference to nudging field !!====================================================================== USE oce ! ocean dynamics and tracers USE dom_oce ! ocean space and time domain USE phycst ! physical constants USE eosbn2 ! equation of state USE sbc_oce ! surface boundary condition: ocean fields USE fldread ! read input field USE iom ! I/O manager library USE in_out_manager ! I/O manager USE lib_mpp ! distribued memory computing USE sbc_ice IMPLICIT NONE PRIVATE PUBLIC sbc_dta_ice ! routine called in sbcmod TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ice ! structure of input ice-cover (file informations, fields read) REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: iceA_dta !ice conc at current time from ancil REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: resto !haddn: restoring coeff. on ice !! * Substitutions # include "domzgr_substitute.h90" # include "vectopt_loop_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/OPA 3.6 , LOCEAN-IPSL (2008) !! $Id$ !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- CONTAINS INTEGER FUNCTION sbcdta_ice_alloc() !!---------------------------------------------------------------------- !! *** FUNCTION sbcdta_ice_alloc *** !!---------------------------------------------------------------------- ALLOCATE( iceA_dta(jpi,jpj) , resto(jpi,jpj), STAT= sbcdta_ice_alloc ) ! IF( lk_mpp ) CALL mpp_sum ( sbcdta_ice_alloc ) IF( sbcdta_ice_alloc > 0 ) CALL ctl_warn('sbcdta_ice_alloc: allocation of arrays failed') ! END FUNCTION sbcdta_ice_alloc SUBROUTINE sbc_dta_ice( kt ) !!--------------------------------------------------------------------- !! *** ROUTINE sbc_dta_ice *** !! !! ** Purpose : the RATE of change of ice concentration implied by nudging !! !! ** Method : - read sea-ice ancillary file !! - take difference to current ice concentration (fr_i) !! !!--------------------------------------------------------------------- INTEGER, INTENT(in) :: kt ! ocean time step ! INTEGER :: ji, jj ! dummy loop indices INTEGER :: ierror ! return error code INTEGER :: ios REAL(wp) :: ztrp, zsice, zt_fzp, zfr_obs REAL(wp) :: zqri, zqrj, zqrp, zqi REAL(wp) :: resto_fact = 24. ! in hours, 1 day relaxation (haddn) !! CHARACTER(len=100) :: cn_dir ! Root directory for location of ice-if files TYPE(FLD_N) :: sn_ice ! informations about the fields to be read NAMELIST/namsbc_ice/ cn_dir, sn_ice !!--------------------------------------------------------------------- ! ! ====================== ! IF( kt == nit000 ) THEN ! First call kt=nit000 ! ! ! ====================== ! ! set file information cn_dir = './' ! directory in which the model is executed ! ... default values (NB: frequency positive => hours, negative => months) ! ! file ! frequency ! variable ! time intep ! clim !'yearly' / ! weights ! rotation ! mask ! ! ! name ! (hours) ! name ! (T/F) ! (T/F) !'monthly' ! file ! pairs ! file ! sn_ice = FLD_N('ice_cover', -1 , 'ice_cov' , .true. , .true. , 'yearly' , '' , '' , '' ) ! above are just the defaults, they will get overwritten by reading the namelist! REWIND( numnam_ref ) ! For future as namsbc_ice is not in namelist_ref currently READ ( numnam_ref, namsbc_ice, IOSTAT = ios, ERR = 901) 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_ice in reference namelist', lwp ) REWIND( numnam_cfg ) ! ... read in namlist namsbc_ice READ ( numnam_cfg, namsbc_ice, IOSTAT = ios, ERR = 902 ) 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_ice in configuration namelist', lwp ) IF( sbcdta_ice_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbcdta_ice_alloc : unable to allocate arrays' ) ierror=0 ALLOCATE( sf_ice(1), STAT=ierror ) IF( ierror > 0 ) THEN CALL ctl_stop( 'sbc_dta_ice: unable to allocate sf_ice structure' ) ; RETURN ENDIF ALLOCATE( sf_ice(1)%fnow(jpi,jpj,1), STAT=ierror ) IF( ierror > 0 ) THEN CALL ctl_stop( 'sbc_dta_ice: unable to allocate sf_ice fnow structure' ) ; RETURN ENDIF IF( sn_ice%ln_tint ) ALLOCATE( sf_ice(1)%fdta(jpi,jpj,1,2), STAT=ierror ) IF( ierror > 0 ) THEN CALL ctl_stop( 'sbc_dta_ice: unable to allocate sf_ice fdta structure' ) ; RETURN ENDIF ! fill sf_ice with sn_ice and control print CALL fld_fill( sf_ice, (/ sn_ice /), cn_dir, 'sbc_dta_ice', 'Ice Conc data', 'namsbc_ice' ) ! ENDIF CALL fld_read( kt, 1, sf_ice ) ! Read input fields and provides the ! ! input fields at the current time-step ! Now calculate the rate of sea ice concentration change and store in ndaice_da. resto(:,:) = (1./resto_fact)*(1./3600.) resto(:,:) = resto(:,:)*tmask(:,:,1) iceA_dta(:,:) = sf_ice(1)%fnow(:,:,1) DO jj = 2, jpjm1 ! DO ji = fs_2, fs_jpim1 ! vector opt. ! check that input ice coverage fields do not have values outside range 0-1: ! HadISST interpolation to ORCA grid can cause values outside this. IF(iceA_dta(ji,jj) < 0.) iceA_dta(ji,jj) = 0. IF(iceA_dta(ji,jj) > 1.) iceA_dta(ji,jj) = 1. ! Calculate DA increment ndaice_da(ji,jj) = resto(ji,jj) * ( iceA_dta(ji,jj) - fr_i(ji,jj) ) ! Check global coords to see if in south Baltic Sea !IF ( ( mjg(jj) > 949 ) .AND. ( mjg(jj) < 1057 ) .AND. & ! ( mig(ji) > 1174 ) .AND. ( mig(ji) < 1241 ) ) THEN !Only output warning once per time step ! IF ( (mjg(jj) == 974) .AND. (mig(ji) == 1206) ) THEN ! write(*,*) 'Warning: Baltic Sea ice and ocean not relaxed. ' ! ENDIF !write(*,*) 'resto(ji,jj), iceA_dta(ji,jj), fr_i(ji,jj), ndaice_da(ji,jj)', resto(ji,jj), iceA_dta(ji,jj), fr_i(ji,jj), ndaice_da(ji,jj) ! ndaice_da(ji,jj) = 0.0_wp ! ENDIF ! CALL ctl_stop( 'Nick testing, stop' ) END DO END DO !write(*,*) "haddn: finished sbc_dta_ice" !write(50+nproc,*) "haddn: iceA_dta: ", iceA_dta END SUBROUTINE sbc_dta_ice !!====================================================================== END MODULE sbcdta_ice