Changeset 2821 for branches/2011/dev_r2787_LOCEAN_offline_fldread
- Timestamp:
- 2011-08-09T11:37:57+02:00 (13 years ago)
- Location:
- branches/2011/dev_r2787_LOCEAN_offline_fldread/NEMOGCM
- Files:
-
- 6 edited
-
CONFIG/ORCA2_OFF_PISCES/EXP00/namelist (modified) (1 diff)
-
NEMO/OFF_SRC/dommsk.F90 (modified) (3 diffs)
-
NEMO/OFF_SRC/domrea.F90 (modified) (1 diff)
-
NEMO/OFF_SRC/dtadyn.F90 (modified) (9 diffs)
-
NEMO/OPA_SRC/trc_oce.F90 (modified) (3 diffs)
-
NEMO/TOP_SRC/oce_trc.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/dev_r2787_LOCEAN_offline_fldread/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist
r2715 r2821 560 560 / 561 561 !----------------------------------------------------------------------- 562 &namdyn ! offline dynamics read in files ("key_offline") 563 !----------------------------------------------------------------------- 564 ndtadyn = 73 ! number of period in the file for one year 565 ndtatot = 73 ! total number of period in the file 566 nsptint = 1 ! indicator for time interpolation 567 lperdyn = .true. ! periodicity of the unique file (T) 568 ! F (default) computed with Blanke' scheme 569 cfile_grid_T = 'dyna_grid_T.nc' ! name of grid_T file 570 cfile_grid_U = 'dyna_grid_U.nc' ! name of grid_U file 571 cfile_grid_V = 'dyna_grid_V.nc' ! name of grid_V file 572 cfile_grid_W = 'dyna_grid_W.nc' ! name of grid_W file 573 / 574 562 &namdta_dyn ! offline dynamics read in files ("key_offline") 563 !----------------------------------------------------------------------- 564 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! 565 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! 566 sn_tem = 'dyna_grid_T' , 120 , 'votemper' , .true. , .true. , 'yearly' , '' , '' 567 sn_sal = 'dyna_grid_T' , 120 , 'vosaline' , .true. , .true. , 'yearly' , '' , '' 568 sn_mld = 'dyna_grid_T' , 120 , 'somixhgt' , .true. , .true. , 'yearly' , '' , '' 569 sn_emp = 'dyna_grid_T' , 120 , 'sowaflcd' , .true. , .true. , 'yearly' , '' , '' 570 sn_ice = 'dyna_grid_T' , 120 , 'soicecov' , .true. , .true. , 'yearly' , '' , '' 571 sn_qsr = 'dyna_grid_T' , 120 , 'soshfldo' , .true. , .true. , 'yearly' , '' , '' 572 sn_wnd = 'dyna_grid_T' , 120 , 'sowindsp' , .true. , .true. , 'yearly' , '' , '' 573 sn_uwd = 'dyna_grid_U' , 120 , 'vozocrtx' , .true. , .true. , 'yearly' , '' , '' 574 sn_vwd = 'dyna_grid_V' , 120 , 'vomecrty' , .true. , .true. , 'yearly' , '' , '' 575 sn_wwd = 'dyna_grid_W' , 120 , 'vovecrtz' , .true. , .true. , 'yearly' , '' , '' 576 sn_avt = 'dyna_grid_W' , 120 , 'voddmavs' , .true. , .true. , 'yearly' , '' , '' 577 sn_ubl = 'dyna_grid_U' , 120 , 'sobblcox' , .true. , .true. , 'yearly' , '' , '' 578 sn_vbl = 'dyna_grid_V' , 120 , 'sobblcoy' , .true. , .true. , 'yearly' , '' , '' 579 sn_eiw = 'dyna_grid_W' , 120 , 'soleaeiw' , .true. , .true. , 'yearly' , '' , '' 580 ! 581 cn_dir = './' ! root directory for the location of the dynamical files 582 ln_degrad = .false. ! flag for degradation - requires ("key_degrad") 583 ln_dynwzv = .true. ! computation of vertical velocity instead of using the one read in file 584 ln_dynbbl = .true. ! bbl coef are in files, so read them - requires ("key_trabbl") 585 / 575 586 !!====================================================================== 576 587 !! Tracers & Dynamics vertical physics namelists -
branches/2011/dev_r2787_LOCEAN_offline_fldread/NEMOGCM/NEMO/OFF_SRC/dommsk.F90
r2715 r2821 19 19 20 20 PUBLIC dom_msk ! routine called by inidom.F90 21 22 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: facvol !: volume for degraded regions23 21 24 22 !! * Substitutions … … 56 54 END IF 57 55 ! 58 #if defined key_degrad59 IF( dom_msk_alloc() /= 0 ) CALL ctl_stop('STOP','dom_msk: unable to allocate arrays')60 #endif61 62 56 ! Interior domain mask (used for global sum) 63 57 ! -------------------- … … 104 98 ! 105 99 END SUBROUTINE dom_msk 106 107 108 INTEGER FUNCTION dom_msk_alloc()109 !!---------------------------------------------------------------------110 !! *** FUNCTION dom_msk_alloc ***111 !!---------------------------------------------------------------------112 ALLOCATE( facvol(jpi,jpj,jpk) , STAT=dom_msk_alloc )113 IF( dom_msk_alloc /= 0 ) CALL ctl_warn('dom_msk_alloc : failed to allocate facvol array')114 !115 END FUNCTION dom_msk_alloc116 117 100 !!====================================================================== 118 101 END MODULE dommsk -
branches/2011/dev_r2787_LOCEAN_offline_fldread/NEMOGCM/NEMO/OFF_SRC/domrea.F90
r2787 r2821 16 16 USE dommsk ! domain: masks 17 17 USE lbclnk ! lateral boundary condition - MPP exchanges 18 USE trc_oce 18 19 USE lib_mpp 19 20 USE in_out_manager -
branches/2011/dev_r2787_LOCEAN_offline_fldread/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90
r2764 r2821 11 11 !! - ! 2005-12 (C. Ethe) Adapted for DEGINT 12 12 !! 3.0 ! 2007-06 (C. Ethe) use of iom module 13 !! - ! 2007-09 (C. Ethe) add swap_dyn_data14 13 !! 3.3 ! 2010-11 (C. Ethe) Full reorganization of the off-line: phasing with the on-line 14 !! 3.4 ! 2011-05 (C. Ethe) Use of fldread 15 15 !!---------------------------------------------------------------------- 16 16 17 17 !!---------------------------------------------------------------------- 18 !! dta_dyn_init : initialization, namelist read, and parameters control18 !! dta_dyn_init : initialization, namelist read, and SAVEs control 19 19 !! dta_dyn : Interpolation of the fields 20 20 !!---------------------------------------------------------------------- … … 24 24 USE zdf_oce ! ocean vertical physics: variables 25 25 USE sbc_oce ! surface module: variables 26 USE trc_oce ! share ocean/biogeo variables 26 27 USE phycst ! physical constants 27 28 USE trabbl ! active tracer: bottom boundary layer … … 36 37 USE iom ! I/O library 37 38 USE lib_mpp ! distributed memory computing library 38 USE prtctl ! print control 39 USE prtctl ! print control 40 USE fldread ! read input fields 39 41 40 42 IMPLICIT NONE … … 44 46 PUBLIC dta_dyn ! called by step.F90 45 47 46 LOGICAL, PUBLIC :: lperdyn = .TRUE. !: boolean for periodic fields or not 47 LOGICAL, PUBLIC :: lfirdyn = .TRUE. !: boolean for the first call or not 48 49 INTEGER, PUBLIC :: ndtadyn = 73 !: Number of dat in one year 50 INTEGER, PUBLIC :: ndtatot = 73 !: Number of data in the input field 51 INTEGER, PUBLIC :: nsptint = 1 !: type of spatial interpolation 52 53 CHARACTER(len=45) :: cfile_grid_T = 'dyna_grid_T.nc' ! name of the grid_T file 54 CHARACTER(len=45) :: cfile_grid_U = 'dyna_grid_U.nc' ! name of the grid_U file 55 CHARACTER(len=45) :: cfile_grid_V = 'dyna_grid_V.nc' ! name of the grid_V file 56 CHARACTER(len=45) :: cfile_grid_W = 'dyna_grid_W.nc' ! name of the grid_W file 57 58 REAL(wp) :: rnspdta ! number of time step per 2 consecutives data 59 REAL(wp) :: rnspdta2 ! rnspdta * 0.5 60 61 INTEGER :: ndyn1, ndyn2 ! 62 INTEGER :: nlecoff = 0 ! switch for the first read 63 INTEGER :: numfl_t, numfl_u, numfl_v, numfl_w 64 65 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: tdta ! temperature at two consecutive times 66 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: sdta ! salinity at two consecutive times 67 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: udta ! zonal velocity at two consecutive times 68 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: vdta ! meridional velocity at two consecutive times 69 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wdta ! vertical velocity at two consecutive times 70 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: avtdta ! vertical diffusivity coefficient 71 72 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hmlddta ! mixed layer depth at two consecutive times 73 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wspddta ! wind speed at two consecutive times 74 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: frlddta ! sea-ice fraction at two consecutive times 75 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: empdta ! E-P at two consecutive times 76 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsrdta ! short wave heat flux at two consecutive times 77 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: bblxdta ! bbl diffusive coef. in the x direction at 2 consecutive times 78 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: bblydta ! bbl diffusive coef. in the y direction at 2 consecutive times 79 LOGICAL :: l_offbbl 80 #if defined key_ldfslp && ! defined key_c1d 81 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: uslpdta ! zonal isopycnal slopes 82 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: vslpdta ! meridional isopycnal slopes 83 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wslpidta ! zonal diapycnal slopes 84 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wslpjdta ! meridional diapycnal slopes 85 #endif 86 #if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv 87 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: aeiwdta ! G&M coefficient 88 #endif 89 #if defined key_degrad 90 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: ahtudta, ahtvdta, ahtwdta ! Lateral diffusivity 91 # if defined key_traldf_eiv 92 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: aeiudta, aeivdta, aeiwdta ! G&M coefficient 93 # endif 94 #endif 48 CHARACTER(len=100) :: cn_dir = './' !: Root directory for location of ssr files 49 LOGICAL :: ln_dynwzv = .true. !: vertical velocity read in a file (T) or computed from u/v (F) 50 LOGICAL :: ln_dynbbl = .true. !: bbl coef read in a file (T) or computed (F) 51 LOGICAL :: ln_degrad = .false. !: degradation option enabled or not 52 53 INTEGER , PARAMETER :: jpfld = 19 ! maximum number of files to read 54 INTEGER , SAVE :: jf_tem ! index of temperature 55 INTEGER , SAVE :: jf_sal ! index of salinity 56 INTEGER , SAVE :: jf_uwd ! index of u-wind 57 INTEGER , SAVE :: jf_vwd ! index of v-wind 58 INTEGER , SAVE :: jf_wwd ! index of w-wind 59 INTEGER , SAVE :: jf_avt ! index of Kz 60 INTEGER , SAVE :: jf_mld ! index of mixed layer deptht 61 INTEGER , SAVE :: jf_emp ! index of water flux 62 INTEGER , SAVE :: jf_qsr ! index of solar radiation 63 INTEGER , SAVE :: jf_wnd ! index of wind speed 64 INTEGER , SAVE :: jf_ice ! index of sea ice cover 65 INTEGER , SAVE :: jf_ubl ! index of u-bbl coef 66 INTEGER , SAVE :: jf_vbl ! index of v-bbl coef 67 INTEGER , SAVE :: jf_ahu ! index of u-diffusivity coef 68 INTEGER , SAVE :: jf_ahv ! index of v-diffusivity coef 69 INTEGER , SAVE :: jf_ahw ! index of w-diffusivity coef 70 INTEGER , SAVE :: jf_eiu ! index of u-eiv 71 INTEGER , SAVE :: jf_eiv ! index of v-eiv 72 INTEGER , SAVE :: jf_eiw ! index of w-eiv 73 74 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_dyn ! structure of input fields (file informations, fields read) 75 ! ! 76 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wdta ! vertical velocity at 2 time step 77 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,: ) :: wnow ! vertical velocity at 2 time step 78 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: uslpdta ! zonal isopycnal slopes 79 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: vslpdta ! meridional isopycnal slopes 80 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wslpidta ! zonal diapycnal slopes 81 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wslpjdta ! meridional diapycnal slopes 82 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uslpnow ! zonal isopycnal slopes 83 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: vslpnow ! meridional isopycnal slopes 84 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wslpinow ! zonal diapycnal slopes 85 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wslpjnow ! meridional diapycnal slopes 86 87 INTEGER :: nrecprev_tem , nrecprev_uwd 95 88 96 89 !! * Substitutions … … 108 101 !! *** ROUTINE dta_dyn *** 109 102 !! 110 !! ** Purpose : Prepares dynamics and physics fields from an NEMO run 111 !! for an off-line simulation of passive tracers 112 !! 113 !! ** Method : calculates the position of DATA to read READ DATA 114 !! (example month changement) computes slopes IF needed 115 !! interpolates DATA IF needed 116 !!---------------------------------------------------------------------- 103 !! ** Purpose : Prepares dynamics and physics fields from a NEMO run 104 !! for an off-line simulation of passive tracers 105 !! 106 !! ** Method : calculates the position of data 107 !! - computes slopes if needed 108 !! - interpolates data if needed 109 !!---------------------------------------------------------------------- 110 ! 111 USE oce, ONLY: zts => tsa 112 USE oce, ONLY: zuslp => ua , zvslp => va 113 USE oce, ONLY: zwslpi => rotb , zwslpj => rotn 114 USE oce, ONLY: zu => ub , zv => vb, zw => hdivb 115 ! 117 116 INTEGER, INTENT(in) :: kt ! ocean time-step index 118 !! 119 INTEGER :: iper, iperm1, iswap, izt ! local integers 120 REAL(wp) :: zt, zweigh ! local scalars 121 !!---------------------------------------------------------------------- 122 123 zt = ( REAL(kt,wp) + rnspdta2 ) / rnspdta 124 izt = INT( zt ) 125 zweigh = zt - REAL( INT(zt), wp ) 126 127 IF( lperdyn ) THEN ; iperm1 = MOD( izt, ndtadyn ) 128 ELSE ; iperm1 = MOD( izt, ndtatot - 1 ) + 1 129 ENDIF 130 131 iper = iperm1 + 1 132 IF( iperm1 == 0 ) THEN 133 IF( lperdyn ) THEN 134 iperm1 = ndtadyn 135 ELSE 136 IF( lfirdyn ) THEN 137 IF(lwp) WRITE (numout,*) 'dta_dyn: dynamic file is not periodic with or without interpolation & 138 & we take the first value for the previous period iperm1 = 0 ' 139 END IF 140 END IF 141 END IF 142 143 iswap = 0 144 145 ! 1. First call lfirdyn = true 146 ! ---------------------------- 147 148 IF( lfirdyn ) THEN 149 ndyn1 = iperm1 ! store the information of the period read 150 ndyn2 = iper 151 152 IF(lwp) THEN 153 WRITE (numout,*) ' dynamics data read for the period ndyn1 =', ndyn1, & 154 & ' and for the period ndyn2 = ', ndyn2 155 WRITE (numout,*) ' time step is : ', kt 156 WRITE (numout,*) ' we have ndtadyn = ', ndtadyn, ' records in the dynamic file for one year' 157 END IF 158 ! 159 CALL dynrea( kt, MAX( 1, iperm1) ) ! data read for the iperm1 period 160 ! 161 CALL swap_dyn_data ! swap from record 2 to 1 162 ! 163 iswap = 1 ! indicates swap 164 ! 165 CALL dynrea( kt, iper ) ! data read for the iper period 166 ! 167 lfirdyn = .FALSE. ! trace the first call 168 ENDIF 169 ! 170 ! And now what we have to do at every time step 171 ! check the validity of the period in memory 172 ! 173 IF( iperm1 /= ndyn1 ) THEN 174 ! 175 IF( iperm1 == 0 ) THEN 176 IF(lwp) THEN 177 WRITE (numout,*) ' dynamic file is not periodic with periodic interpolation' 178 WRITE (numout,*) ' we take the last value for the last period ' 179 WRITE (numout,*) ' iperm1 = 12, iper = 13 ' 117 ! 118 INTEGER :: ji, jj ! dummy loop indices 119 INTEGER :: isecsbc ! number of seconds between Jan. 1st 00h of nit000 year and the middle of time step 120 REAL(wp) :: ztinta ! ratio applied to after records when doing time interpolation 121 REAL(wp) :: ztintb ! ratio applied to before records when doing time interpolation 122 INTEGER :: iswap_tem, iswap_uwd ! 123 !!---------------------------------------------------------------------- 124 125 isecsbc = nsec_year + nsec1jan000 126 127 IF( kt /= nit000 ) THEN 128 nrecprev_tem = sf_dyn(jf_tem)%nrec_a(2) 129 nrecprev_uwd = sf_dyn(jf_uwd)%nrec_a(2) 130 ENDIF 131 132 CALL fld_read( kt, 1, sf_dyn ) !== read data at kt time step ==! 133 134 ! 135 IF( lk_ldfslp ) THEN ! Computes slopes (here avt is used as workspace) 136 iswap_tem = 0 137 IF( kt /= nit000 .AND. ( sf_dyn(jf_tem)%nrec_a(2) - nrecprev_tem ) /= 0 ) iswap_tem = 1 138 IF( ( isecsbc > sf_dyn(jf_tem)%nrec_b(2) .AND. iswap_tem == 1 ) .OR. kt == nit000 ) THEN ! read/update the after data 139 write(numout,*) 140 write(numout,*) ' Compute new slopes at kt = ', kt 141 IF( sf_dyn(jf_tem)%ln_tint ) THEN ! time interpolation of data 142 uslpdta (:,:,:,1) = uslpdta (:,:,:,2) ! swap the data 143 vslpdta (:,:,:,1) = vslpdta (:,:,:,2) 144 wslpidta(:,:,:,1) = wslpidta(:,:,:,2) 145 wslpjdta(:,:,:,1) = wslpjdta(:,:,:,2) 146 ! 147 zts(:,:,:,jf_tem) = sf_dyn(jf_tem)%fdta(:,:,:,2) * tmask(:,:,:) ! temperature 148 zts(:,:,:,jf_sal) = sf_dyn(jf_sal)%fdta(:,:,:,2) * tmask(:,:,:) ! salinity 149 avt(:,:,:) = sf_dyn(jf_avt)%fdta(:,:,:,2) * tmask(:,:,:) ! vertical diffusive coef. 150 CALL dta_dyn_slp( kt, zts, zuslp, zvslp, zwslpi, zwslpj ) 151 uslpdta (:,:,:,2) = zuslp (:,:,:) 152 vslpdta (:,:,:,2) = zvslp (:,:,:) 153 wslpidta(:,:,:,2) = zwslpi(:,:,:) 154 wslpjdta(:,:,:,2) = zwslpj(:,:,:) 155 ELSE 156 zts(:,:,:,jf_tem) = sf_dyn(jf_tem)%fnow(:,:,:) * tmask(:,:,:) 157 zts(:,:,:,jf_sal) = sf_dyn(jf_sal)%fnow(:,:,:) * tmask(:,:,:) 158 avt(:,:,:) = sf_dyn(jf_avt)%fnow(:,:,:) * tmask(:,:,:) 159 CALL dta_dyn_slp( kt, zts, zuslp, zvslp, zwslpi, zwslpj ) 160 uslpnow (:,:,:) = zuslp (:,:,:) 161 vslpnow (:,:,:) = zvslp (:,:,:) 162 wslpinow(:,:,:) = zwslpi(:,:,:) 163 wslpjnow(:,:,:) = zwslpj(:,:,:) 180 164 ENDIF 181 iperm1 = 12 182 iper = 13 183 ENDIF 184 ! 185 CALL swap_dyn_data ! We have to prepare a new read of data : swap from record 2 to 1 186 ! 187 iswap = 1 ! indicates swap 188 ! 189 CALL dynrea( kt, iper ) ! data read for the iper period 190 ! 191 ndyn1 = ndyn2 ! store the information of the period read 192 ndyn2 = iper 193 ! 194 IF(lwp) THEN 195 WRITE (numout,*) ' dynamics data read for the period ndyn1 =', ndyn1, & 196 & ' and for the period ndyn2 = ', ndyn2 197 WRITE (numout,*) ' time step is : ', kt 198 END IF 199 ! 200 END IF 201 ! 202 ! Compute the data at the given time step 203 !---------------------------------------- 204 205 IF( nsptint == 0 ) THEN ! No space interpolation, data are probably correct 206 ! ! We have to initialize data if we have changed the period 207 CALL assign_dyn_data 208 ELSEIF( nsptint == 1 ) THEN ! linear interpolation 209 CALL linear_interp_dyn_data( zweigh ) 210 ELSE ! other interpolation 211 WRITE (numout,*) ' this kind of interpolation do not exist at the moment : we stop' 212 STOP 'dtadyn' 213 END IF 214 ! 215 CALL eos( tsn, rhd, rhop ) ! In any case, we need rhop 216 ! 217 #if ! defined key_degrad && defined key_traldf_c2d 218 ! ! In case of 2D varying coefficients, we need aeiv and aeiu 219 IF( lk_traldf_eiv ) CALL dta_eiv( kt ) ! eddy induced velocity coefficient 220 #endif 221 ! 222 IF( .NOT. l_offbbl ) THEN ! Compute bbl coefficients if needed 165 ENDIF 166 IF( sf_dyn(jf_tem)%ln_tint ) THEN 167 ztinta = REAL( isecsbc - sf_dyn(jf_tem)%nrec_b(2), wp ) & 168 & / REAL( sf_dyn(jf_tem)%nrec_a(2) - sf_dyn(jf_tem)%nrec_b(2), wp ) 169 ztintb = 1. - ztinta 170 uslp (:,:,:) = ztintb * uslpdta (:,:,:,1) + ztinta * uslpdta (:,:,:,2) 171 vslp (:,:,:) = ztintb * vslpdta (:,:,:,1) + ztinta * vslpdta (:,:,:,2) 172 wslpi(:,:,:) = ztintb * wslpidta(:,:,:,1) + ztinta * wslpidta(:,:,:,2) 173 wslpj(:,:,:) = ztintb * wslpjdta(:,:,:,1) + ztinta * wslpjdta(:,:,:,2) 174 ELSE 175 uslp (:,:,:) = uslpnow (:,:,:) 176 vslp (:,:,:) = vslpnow (:,:,:) 177 wslpi(:,:,:) = wslpinow(:,:,:) 178 wslpj(:,:,:) = wslpjnow(:,:,:) 179 ENDIF 180 ENDIF 181 ! 182 IF( ln_dynwzv ) THEN ! compute vertical velocity from u/v 183 iswap_uwd = 0 184 IF( kt /= nit000 .AND. ( sf_dyn(jf_uwd)%nrec_a(2) - nrecprev_uwd ) /= 0 ) iswap_uwd = 1 185 IF( ( isecsbc > sf_dyn(jf_uwd)%nrec_b(2) .AND. iswap_uwd == 1 ) .OR. kt == nit000 ) THEN ! read/update the after data 186 write(numout,*) ' Compute new vertical velocity at kt = ', kt 187 write(numout,*) 188 IF( sf_dyn(jf_uwd)%ln_tint ) THEN ! time interpolation of data 189 wdta(:,:,:,1) = wdta(:,:,:,2) ! swap the data 190 zu(:,:,:) = sf_dyn(jf_uwd)%fdta(:,:,:,2) 191 zv(:,:,:) = sf_dyn(jf_vwd)%fdta(:,:,:,2) 192 CALL dta_dyn_wzv( zu, zv, zw ) 193 wdta(:,:,:,2) = zw(:,:,:) * tmask(:,:,:) 194 ELSE 195 zu(:,:,:) = sf_dyn(jf_uwd)%fnow(:,:,:) 196 zv(:,:,:) = sf_dyn(jf_vwd)%fnow(:,:,:) 197 CALL dta_dyn_wzv( zu, zv, zw ) 198 wnow(:,:,:) = zw(:,:,:) * tmask(:,:,:) 199 ENDIF 200 ENDIF 201 IF( sf_dyn(jf_uwd)%ln_tint ) THEN 202 ztinta = REAL( isecsbc - sf_dyn(jf_uwd)%nrec_b(2), wp ) & 203 & / REAL( sf_dyn(jf_uwd)%nrec_a(2) - sf_dyn(jf_uwd)%nrec_b(2), wp ) 204 ztintb = 1. - ztinta 205 wn(:,:,:) = ztintb * wdta(:,:,:,1) + ztinta * wdta(:,:,:,2) 206 ELSE 207 wn(:,:,:) = wnow(:,:,:) 208 ENDIF 209 ENDIF 210 ! 211 tsn(:,:,:,jf_tem) = sf_dyn(jf_tem)%fnow(:,:,:) * tmask(:,:,:) ! temperature 212 tsn(:,:,:,jf_sal) = sf_dyn(jf_sal)%fnow(:,:,:) * tmask(:,:,:) ! salinity 213 ! 214 CALL eos( tsn, rhd, rhop ) ! In any case, we need rhop 215 ! 216 avt(:,:,:) = sf_dyn(jf_avt)%fnow(:,:,:) * tmask(:,:,:) ! vertical diffusive coefficient 217 un (:,:,:) = sf_dyn(jf_uwd)%fnow(:,:,:) * umask(:,:,:) ! u-velocity 218 vn (:,:,:) = sf_dyn(jf_vwd)%fnow(:,:,:) * vmask(:,:,:) ! v-velocity 219 IF( .NOT.ln_dynwzv ) & ! w-velocity read in file 220 wn (:,:,:) = sf_dyn(jf_wwd)%fnow(:,:,:) * tmask(:,:,:) 221 hmld(:,:) = sf_dyn(jf_mld)%fnow(:,:,1) * tmask(:,:,1) ! mixed layer depht 222 wndm(:,:) = sf_dyn(jf_wnd)%fnow(:,:,1) * tmask(:,:,1) ! wind speed - needed for gas exchange 223 emp (:,:) = sf_dyn(jf_emp)%fnow(:,:,1) * tmask(:,:,1) ! E-P 224 emps(:,:) = emp(:,:) 225 fr_i(:,:) = sf_dyn(jf_ice)%fnow(:,:,1) * tmask(:,:,1) ! Sea-ice fraction 226 qsr (:,:) = sf_dyn(jf_qsr)%fnow(:,:,1) * tmask(:,:,1) ! solar radiation 227 ! ! bbl diffusive coef 228 #if defined key_trabbl 229 IF( ln_dynbbl ) THEN ! read in a file 230 ahu_bbl(:,:) = sf_dyn(jf_ubl)%fnow(:,:,1) * umask(:,:,1) 231 ahv_bbl(:,:) = sf_dyn(jf_vbl)%fnow(:,:,1) * umask(:,:,1) 232 ELSE ! Compute bbl coefficients if needed 223 233 tsb(:,:,:,:) = tsn(:,:,:,:) 224 234 CALL bbl( kt, 'TRC') 225 235 END IF 226 ! 227 IF(ln_ctl) THEN 228 CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' tn - : ', mask1=tmask, ovlap=1, kdim=jpk ) 229 CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_sal), clinfo1=' sn - : ', mask1=tmask, ovlap=1, kdim=jpk ) 236 #endif 237 #if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv 238 aeiw(:,:) = sf_dyn(jf_eiw)%fnow(:,:,1) * tmask(:,:,1) ! w-eiv 239 ! ! Computes the horizontal values from the vertical value 240 DO jj = 2, jpjm1 241 DO ji = fs_2, fs_jpim1 ! vector opt. 242 aeiu(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji+1,jj ) ) ! Average the diffusive coefficient at u- v- points 243 aeiv(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji ,jj+1) ) ! at u- v- points 244 END DO 245 END DO 246 CALL lbc_lnk( aeiu, 'U', 1. ) ; CALL lbc_lnk( aeiv, 'V', 1. ) ! lateral boundary condition 247 #endif 248 249 #if defined key_degrad 250 ! ! degrad option : diffusive and eiv coef are 3D 251 ahtu(:,:,:) = sf_dyn(jf_ahu)%fnow(:,:,:) * umask(:,:,:) 252 ahtv(:,:,:) = sf_dyn(jf_ahv)%fnow(:,:,:) * umask(:,:,:) 253 ahtw(:,:,:) = sf_dyn(jf_ahw)%fnow(:,:,:) * umask(:,:,:) 254 # if defined key_traldf_eiv 255 aeiu(:,:,:) = sf_dyn(jf_eiu)%fnow(:,:,:) * umask(:,:,:) 256 aeiv(:,:,:) = sf_dyn(jf_eiv)%fnow(:,:,:) * umask(:,:,:) 257 aeiw(:,:,:) = sf_dyn(jf_eiw)%fnow(:,:,:) * umask(:,:,:) 258 # endif 259 #endif 260 ! 261 IF(ln_ctl) THEN ! print control 262 CALL prt_ctl(tab3d_1=tsn(:,:,:,jf_tem), clinfo1=' tn - : ', mask1=tmask, ovlap=1, kdim=jpk ) 263 CALL prt_ctl(tab3d_1=tsn(:,:,:,jf_sal), clinfo1=' sn - : ', mask1=tmask, ovlap=1, kdim=jpk ) 230 264 CALL prt_ctl(tab3d_1=un , clinfo1=' un - : ', mask1=tmask, ovlap=1, kdim=jpk ) 231 265 CALL prt_ctl(tab3d_1=vn , clinfo1=' vn - : ', mask1=tmask, ovlap=1, kdim=jpk ) … … 242 276 243 277 244 INTEGER FUNCTION dta_dyn_alloc() 245 !!--------------------------------------------------------------------- 246 !! *** ROUTINE dta_dyn_alloc *** 247 !!--------------------------------------------------------------------- 248 249 ALLOCATE( tdta (jpi,jpj,jpk,2), sdta (jpi,jpj,jpk,2), & 250 & udta (jpi,jpj,jpk,2), vdta (jpi,jpj,jpk,2), & 251 & wdta (jpi,jpj,jpk,2), avtdta (jpi,jpj,jpk,2), & 252 #if defined key_ldfslp && ! defined key_c1d 253 & uslpdta (jpi,jpj,jpk,2), vslpdta (jpi,jpj,jpk,2), & 254 & wslpidta(jpi,jpj,jpk,2), wslpjdta(jpi,jpj,jpk,2), & 255 #endif 256 #if defined key_degrad 257 & ahtudta (jpi,jpj,jpk,2), ahtvdta (jpi,jpj,jpk,2), & 258 & ahtwdta (jpi,jpj,jpk,2), & 259 # if defined key_traldf_eiv 260 & aeiudta (jpi,jpj,jpk,2), aeivdta (jpi,jpj,jpk,2), & 261 & aeiwdta (jpi,jpj,jpk,2), & 262 # endif 263 #endif 264 #if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv 265 & aeiwdta (jpi,jpj, 2), & 266 #endif 267 & hmlddta (jpi,jpj, 2), wspddta (jpi,jpj, 2), & 268 & frlddta (jpi,jpj, 2), qsrdta (jpi,jpj, 2), & 269 & empdta (jpi,jpj, 2), STAT=dta_dyn_alloc ) 270 ! 271 IF( dta_dyn_alloc /= 0 ) CALL ctl_warn('dta_dyn_alloc: failed to allocate facvol array') 272 ! 273 END FUNCTION dta_dyn_alloc 274 275 276 SUBROUTINE dynrea( kt, kenr ) 277 !!---------------------------------------------------------------------- 278 !! *** ROUTINE dynrea *** 279 !! 280 !! ** Purpose : READ dynamics fiels from OPA9 netcdf output 281 !! 282 !! ** Method : READ the kenr records of DATA and store in udta(...,2), .... 283 !!---------------------------------------------------------------------- 284 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 285 USE wrk_nemo, ONLY: zu => wrk_3d_3 , zv => wrk_3d_4 , zw => wrk_3d_5 286 USE wrk_nemo, ONLY: zt => wrk_3d_6 , zs => wrk_3d_7 , zavt => wrk_3d_8 287 USE wrk_nemo, ONLY: zemp => wrk_2d_11 , zqsr => wrk_2d_12, zmld => wrk_2d_13 288 USE wrk_nemo, ONLY: zice => wrk_2d_14 , zwspd => wrk_2d_15 289 USE wrk_nemo, ONLY: ztaux => wrk_2d_16 , ztauy => wrk_2d_17 290 USE wrk_nemo, ONLY: zbblx => wrk_2d_18 , zbbly => wrk_2d_19 291 USE wrk_nemo, ONLY: zaeiw2d => wrk_2d_10 292 USE wrk_nemo, ONLY: ztsn => wrk_4d_1 293 ! 294 INTEGER, INTENT(in) :: kt, kenr ! time index 295 !! 296 INTEGER :: jkenr 297 #if defined key_degrad 298 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zahtu, zahtv, zahtw ! Lateral diffusivity 299 # if defined key_traldf_eiv 300 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zaeiu, zaeiv, zaeiw ! G&M coefficient 301 # endif 302 #endif 303 !!---------------------------------------------------------------------- 304 ! 305 IF( wrk_in_use(3, 3,4,5,6,7,8) .OR. & 306 wrk_in_use(4, 1) .OR. & 307 wrk_in_use(2, 10,11,12,13,14,15,16,17,18,19) ) THEN 308 CALL ctl_stop('domrea/dta_dyn: requested workspace arrays unavailable') ; RETURN 309 ENDIF 310 311 #if defined key_degrad 312 ALLOCATE( zahtu(jpi,jpj,jpk), zahtv(jpi,jpj,jpk), zahtw(jpi,jpj,jpk) ) 313 # if defined key_traldf_eiv 314 ALLOCATE( zaeiu(jpi,jpj,jpk), zaeiv(jpi,jpj,jpk), zaeiw(jpi,jpj,jpk) ) 315 # endif 316 #endif 317 318 ! cas d'un fichier non periodique : on utilise deux fois le premier et 319 ! le dernier champ temporel 320 321 jkenr = kenr 322 278 SUBROUTINE dta_dyn_init 279 !!---------------------------------------------------------------------- 280 !! *** ROUTINE dta_dyn_init *** 281 !! 282 !! ** Purpose : Initialisation of the dynamical data 283 !! ** Method : - read the data namdta_dyn namelist 284 !! 285 !! ** Action : - read parameters 286 !!---------------------------------------------------------------------- 287 INTEGER :: ierr, ierr0, ierr1, ierr2, ierr3 ! return error code 288 INTEGER :: ifpr ! dummy loop indice 289 INTEGER :: jfld ! dummy loop arguments 290 INTEGER :: inum, idv, idimv ! local integer 291 !! 292 CHARACTER(len=100) :: cn_dir ! Root directory for location of core files 293 TYPE(FLD_N), DIMENSION(jpfld) :: slf_d ! array of namelist informations on the fields to read 294 TYPE(FLD_N) :: sn_tem, sn_sal, sn_mld, sn_emp, sn_ice, sn_qsr, sn_wnd ! informations about the fields to be read 295 TYPE(FLD_N) :: sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl ! " " 296 TYPE(FLD_N) :: sn_ahu, sn_ahv, sn_ahw, sn_eiu, sn_eiv, sn_eiw ! " " 297 ! 298 NAMELIST/namdta_dyn/cn_dir, ln_dynwzv, ln_dynbbl, ln_degrad, & 299 & sn_tem, sn_sal, sn_mld, sn_emp, sn_ice, sn_qsr, sn_wnd, & 300 & sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl, & 301 & sn_ahu, sn_ahv, sn_ahw, sn_eiu, sn_eiv, sn_eiw 302 303 !!---------------------------------------------------------------------- 304 ! ! ============ 305 ! ! Namelist 306 ! ! ============ 307 ! (NB: frequency positive => hours, negative => months) 308 ! ! file ! frequency ! variable ! time intep ! clim ! 'yearly' or ! weights ! rotation ! 309 ! ! name ! (hours) ! name ! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs ! 310 sn_tem = FLD_N( 'dyna_grid_T' , 120 , 'votemper' , .true. , .true. , 'yearly' , '' , '' ) 311 sn_sal = FLD_N( 'dyna_grid_T' , 120 , 'vosaline' , .true. , .true. , 'yearly' , '' , '' ) 312 sn_mld = FLD_N( 'dyna_grid_T' , 120 , 'somixght' , .true. , .true. , 'yearly' , '' , '' ) 313 sn_emp = FLD_N( 'dyna_grid_T' , 120 , 'sowaflcd' , .true. , .true. , 'yearly' , '' , '' ) 314 sn_ice = FLD_N( 'dyna_grid_T' , 120 , 'soicecov' , .true. , .true. , 'yearly' , '' , '' ) 315 sn_qsr = FLD_N( 'dyna_grid_T' , 120 , 'soshfldo' , .true. , .true. , 'yearly' , '' , '' ) 316 sn_wnd = FLD_N( 'dyna_grid_T' , 120 , 'sowindsp' , .true. , .true. , 'yearly' , '' , '' ) 317 sn_uwd = FLD_N( 'dyna_grid_U' , 120 , 'vozocrtx' , .true. , .true. , 'yearly' , '' , '' ) 318 sn_vwd = FLD_N( 'dyna_grid_V' , 120 , 'vomecrty' , .true. , .true. , 'yearly' , '' , '' ) 319 sn_wwd = FLD_N( 'dyna_grid_W' , 120 , 'vovecrtz' , .true. , .true. , 'yearly' , '' , '' ) 320 sn_avt = FLD_N( 'dyna_grid_W' , 120 , 'votkeavt' , .true. , .true. , 'yearly' , '' , '' ) 321 sn_ubl = FLD_N( 'dyna_grid_U' , 120 , 'sobblcox' , .true. , .true. , 'yearly' , '' , '' ) 322 sn_vbl = FLD_N( 'dyna_grid_V' , 120 , 'sobblcoy' , .true. , .true. , 'yearly' , '' , '' ) 323 sn_ahu = FLD_N( 'dyna_grid_U' , 120 , 'vozoahtu' , .true. , .true. , 'yearly' , '' , '' ) 324 sn_ahv = FLD_N( 'dyna_grid_V' , 120 , 'vomeahtv' , .true. , .true. , 'yearly' , '' , '' ) 325 sn_ahw = FLD_N( 'dyna_grid_W' , 120 , 'voveahtz' , .true. , .true. , 'yearly' , '' , '' ) 326 sn_eiu = FLD_N( 'dyna_grid_U' , 120 , 'vozoaeiu' , .true. , .true. , 'yearly' , '' , '' ) 327 sn_eiv = FLD_N( 'dyna_grid_V' , 120 , 'vomeaeiv' , .true. , .true. , 'yearly' , '' , '' ) 328 sn_eiw = FLD_N( 'dyna_grid_W' , 120 , 'voveaeiw' , .true. , .true. , 'yearly' , '' , '' ) 329 ! 330 REWIND( numnam ) ! read in namlist namdta_dyn 331 READ ( numnam, namdta_dyn ) 332 ! ! store namelist information in an array 333 ! ! Control print 323 334 IF(lwp) THEN 324 335 WRITE(numout,*) 325 WRITE(numout,*) 'Dynrea : read dynamical fields, kenr = ', jkenr 326 WRITE(numout,*) '~~~~~~~' 327 #if defined key_degrad 328 WRITE(numout,*) ' Degraded fields' 329 #endif 336 WRITE(numout,*) 'dta_dyn : offline dynamics ' 337 WRITE(numout,*) '~~~~~~~ ' 338 WRITE(numout,*) ' Namelist namdta_dyn' 339 WRITE(numout,*) ' vertical velocity read from file (T) or computed (F) ln_dynwzv = ', ln_dynwzv 340 WRITE(numout,*) ' bbl coef read from file (T) or computed (F) ln_dynbbl = ', ln_dynbbl 341 WRITE(numout,*) ' degradation option enabled (T) or not (F) ln_degrad = ', ln_degrad 330 342 WRITE(numout,*) 331 343 ENDIF 332 333 334 IF( kt == nit000 .AND. nlecoff == 0 ) THEN 335 nlecoff = 1 336 CALL iom_open ( cfile_grid_T, numfl_t ) 337 CALL iom_open ( cfile_grid_U, numfl_u ) 338 CALL iom_open ( cfile_grid_V, numfl_v ) 339 CALL iom_open ( cfile_grid_W, numfl_w ) 340 ENDIF 341 342 ! file grid-T 343 !--------------- 344 CALL iom_get( numfl_t, jpdom_data, 'votemper', zt (:,:,:), jkenr ) 345 CALL iom_get( numfl_t, jpdom_data, 'vosaline', zs (:,:,:), jkenr ) 346 CALL iom_get( numfl_t, jpdom_data, 'somixhgt', zmld (:,: ), jkenr ) 347 CALL iom_get( numfl_t, jpdom_data, 'sowaflcd', zemp (:,: ), jkenr ) 348 CALL iom_get( numfl_t, jpdom_data, 'soshfldo', zqsr (:,: ), jkenr ) 349 CALL iom_get( numfl_t, jpdom_data, 'soicecov', zice (:,: ), jkenr ) 350 IF( iom_varid( numfl_t, 'sowindsp', ldstop = .FALSE. ) > 0 ) THEN 351 CALL iom_get( numfl_t, jpdom_data, 'sowindsp', zwspd(:,:), jkenr ) 344 ! 345 IF( ln_degrad .AND. .NOT.lk_degrad ) THEN 346 CALL ctl_warn( 'dta_dyn_init: degradation option requires key_degrad activated ; force ln_degrad to false' ) 347 ln_degrad = .FALSE. 348 ENDIF 349 IF( ln_dynbbl .AND. .NOT.lk_trabbl ) THEN 350 CALL ctl_warn( 'dta_dyn_init: bbl option requires key_trabbl activated ; force ln_dynbbl to false' ) 351 ln_dynbbl = .FALSE. 352 ENDIF 353 354 jf_tem = 1 ; jf_sal = 2 ; jf_mld = 3 ; jf_emp = 4 ; jf_ice = 5 ; jf_qsr = 6 355 jf_wnd = 7 ; jf_uwd = 8 ; jf_vwd = 9 ; jf_wwd = 10 ; jf_avt = 11 ; jfld = 11 356 ! 357 slf_d(jf_tem) = sn_tem ; slf_d(jf_sal) = sn_sal ; slf_d(jf_mld) = sn_mld 358 slf_d(jf_emp) = sn_emp ; slf_d(jf_ice) = sn_ice ; slf_d(jf_qsr) = sn_qsr 359 slf_d(jf_wnd) = sn_wnd ; slf_d(jf_uwd) = sn_uwd ; slf_d(jf_vwd) = sn_vwd 360 slf_d(jf_wwd) = sn_wwd ; slf_d(jf_avt) = sn_avt 361 ! 362 IF( .NOT.ln_degrad ) THEN ! no degrad option 363 IF( lk_traldf_eiv .AND. ln_dynbbl ) THEN ! eiv & bbl 364 jf_ubl = 12 ; jf_vbl = 13 ; jf_eiw = 14 ; jfld = 14 365 slf_d(jf_ubl) = sn_ubl ; slf_d(jf_vbl) = sn_vbl ; slf_d(jf_eiw) = sn_eiw 366 ENDIF 367 IF( .NOT.lk_traldf_eiv .AND. ln_dynbbl ) THEN ! no eiv & bbl 368 jf_ubl = 12 ; jf_vbl = 13 ; jfld = 13 369 slf_d(jf_ubl) = sn_ubl ; slf_d(jf_vbl) = sn_vbl 370 ENDIF 371 IF( lk_traldf_eiv .AND. .NOT.ln_dynbbl ) THEN ! eiv & no bbl 372 jf_eiw = 12 ; jfld = 12 ; slf_d(jf_eiw) = sn_eiw 373 ENDIF 352 374 ELSE 353 CALL iom_get( numfl_u, jpdom_data, 'sozotaux', ztaux(:,:), jkenr ) 354 CALL iom_get( numfl_v, jpdom_data, 'sometauy', ztauy(:,:), jkenr ) 355 CALL tau2wnd( ztaux, ztauy, zwspd ) 356 ENDIF 357 ! files grid-U / grid_V 358 CALL iom_get( numfl_u, jpdom_data, 'vozocrtx', zu (:,:,:), jkenr ) 359 CALL iom_get( numfl_v, jpdom_data, 'vomecrty', zv (:,:,:), jkenr ) 360 #if defined key_trabbl 361 IF( .NOT. lk_c1d .AND. nn_bbl_ldf == 1 ) THEN 362 IF( iom_varid( numfl_u, 'ahu_bbl', ldstop = .FALSE. ) > 0 .AND. & 363 & iom_varid( numfl_v, 'ahv_bbl', ldstop = .FALSE. ) > 0 ) THEN 364 CALL iom_get( numfl_u, jpdom_data, 'ahu_bbl', zbblx(:,:), jkenr ) 365 CALL iom_get( numfl_v, jpdom_data, 'ahv_bbl', zbbly(:,:), jkenr ) 366 l_offbbl = .TRUE. 367 ENDIF 368 ENDIF 369 #endif 370 371 ! file grid-W 372 ! CALL iom_get ( numfl_w, jpdom_data, 'vovecrtz', zw (:,:,:), jkenr ) 373 ! Computation of vertical velocity using horizontal divergence 374 CALL wzv( zu, zv, zw ) 375 376 IF( iom_varid( numfl_w, 'voddmavs', ldstop = .FALSE. ) > 0 ) THEN ! avs exist: it is used 377 CALL iom_get( numfl_w, jpdom_data, 'voddmavs', zavt (:,:,:), jkenr ) 378 ELSE ! no avs: use avt 379 CALL iom_get( numfl_w, jpdom_data, 'votkeavt', zavt (:,:,:), jkenr ) 380 ENDIF 381 382 #if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv 383 CALL iom_get( numfl_w, jpdom_data, 'soleaeiw', zaeiw2d(:,: ), jkenr ) 384 #endif 385 386 #if defined key_degrad 387 CALL iom_get( numfl_u, jpdom_data, 'vozoahtu', zahtu(:,:,:), jkenr ) 388 CALL iom_get( numfl_v, jpdom_data, 'vomeahtv', zahtv(:,:,:), jkenr ) 389 CALL iom_get( numfl_w, jpdom_data, 'voveahtw', zahtw(:,:,:), jkenr ) 390 # if defined key_traldf_eiv 391 CALL iom_get( numfl_u, jpdom_data, 'vozoaeiu', zaeiu(:,:,:), jkenr ) 392 CALL iom_get( numfl_v, jpdom_data, 'vomeaeiv', zaeiv(:,:,:), jkenr ) 393 CALL iom_get( numfl_w, jpdom_data, 'voveaeiw', zaeiw(:,:,:), jkenr ) 394 # endif 395 #endif 396 397 udta (:,:,:,2) = zu (:,:,:) * umask(:,:,:) 398 vdta (:,:,:,2) = zv (:,:,:) * vmask(:,:,:) 399 wdta (:,:,:,2) = zw (:,:,:) * tmask(:,:,:) 400 tdta (:,:,:,2) = zt (:,:,:) * tmask(:,:,:) 401 sdta (:,:,:,2) = zs (:,:,:) * tmask(:,:,:) 402 avtdta(:,:,:,2) = zavt(:,:,:) * tmask(:,:,:) 403 404 #if defined key_ldfslp && ! defined key_c1d 405 ! Computes slopes (here tsn and avt are used as workspace) 406 ztsn (:,:,:,jp_tem) = tdta (:,:,:,2) 407 ztsn (:,:,:,jp_sal) = sdta (:,:,:,2) 408 avt(:,:,:) = avtdta(:,:,:,2) 409 410 CALL eos( ztsn, rhd, rhop ) ! Time-filtered in situ density 411 CALL bn2( ztsn, rn2 ) ! before Brunt-Vaisala frequency 412 IF( ln_zps ) & 413 & CALL zps_hde( kt, jpts, ztsn, gtsu, gtsv, & ! Partial steps: before Horizontal DErivative 414 & rhd, gru , grv ) ! of t, s, rd at the bottom ocean level 415 CALL zdf_mxl( kt ) ! mixed layer depth 416 CALL ldf_slp( kt, rhd, rn2 ) 417 418 uslpdta (:,:,:,2) = uslp (:,:,:) 419 vslpdta (:,:,:,2) = vslp (:,:,:) 420 wslpidta(:,:,:,2) = wslpi(:,:,:) 421 wslpjdta(:,:,:,2) = wslpj(:,:,:) 422 #endif 423 424 #if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv 425 aeiwdta(:,:,2) = zaeiw2d(:,:) * tmask(:,:,1) 426 #endif 427 428 #if defined key_degrad 429 ahtudta(:,:,:,2) = zahtu(:,:,:) * umask(:,:,:) 430 ahtvdta(:,:,:,2) = zahtv(:,:,:) * vmask(:,:,:) 431 ahtwdta(:,:,:,2) = zahtw(:,:,:) * tmask(:,:,:) 432 # if defined key_traldf_eiv 433 aeiudta(:,:,:,2) = zaeiu(:,:,:) * umask(:,:,:) 434 aeivdta(:,:,:,2) = zaeiv(:,:,:) * vmask(:,:,:) 435 aeiwdta(:,:,:,2) = zaeiw(:,:,:) * tmask(:,:,:) 436 # endif 437 #endif 438 439 ! fluxes 440 ! 441 wspddta(:,:,2) = zwspd(:,:) * tmask(:,:,1) 442 frlddta(:,:,2) = zice (:,:) * tmask(:,:,1) 443 empdta (:,:,2) = zemp (:,:) * tmask(:,:,1) 444 qsrdta (:,:,2) = zqsr (:,:) * tmask(:,:,1) 445 hmlddta(:,:,2) = zmld (:,:) * tmask(:,:,1) 446 447 #if defined key_trabbl 448 IF( l_offbbl ) THEN 449 bblxdta(:,:,2) = zbblx(:,:) * umask(:,:,1) 450 bblydta(:,:,2) = zbbly(:,:) * vmask(:,:,1) 451 ENDIF 452 #endif 453 454 IF( kt == nitend ) THEN 455 CALL iom_close ( numfl_t ) 456 CALL iom_close ( numfl_u ) 457 CALL iom_close ( numfl_v ) 458 CALL iom_close ( numfl_w ) 459 ENDIF 460 ! 461 IF( wrk_not_released(3, 3,4,5,6,7,8) .OR. & 462 wrk_not_released(4, 1 ) .OR. & 463 wrk_not_released(2, 10,11,12,13,14,15,16,17,18,19) ) THEN 464 CALL ctl_stop('domrea/dta_dyn: failed to release workspace arrays') 465 END IF 466 #if defined key_degrad 467 DEALLOCATE( zahtu ) ; DEALLOCATE( zahtv ) ; DEALLOCATE( zahtw ) 468 # if defined key_traldf_eiv 469 DEALLOCATE( zaeiu ) ; DEALLOCATE( zaeiv ) ; DEALLOCATE( zaeiw ) 470 # endif 471 #endif 472 ! 473 END SUBROUTINE dynrea 474 475 476 SUBROUTINE dta_dyn_init 477 !!---------------------------------------------------------------------- 478 !! *** ROUTINE dta_dyn_init *** 479 !! 480 !! ** Purpose : initializations of parameters for the interpolation 481 !! 482 !! ** Method : 483 !!---------------------------------------------------------------------- 484 REAL(wp) :: znspyr !: number of time step per year 485 ! 486 NAMELIST/namdyn/ ndtadyn, ndtatot, nsptint, lperdyn, & 487 & cfile_grid_T, cfile_grid_U, cfile_grid_V, cfile_grid_W 488 !!---------------------------------------------------------------------- 489 ! 490 IF( dta_dyn_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dta_dyn_alloc: unable to allocate standard ocean arrays' ) 491 ! 492 REWIND( numnam ) ! Read Namelist namdyn : Lateral physics on tracers 493 READ ( numnam, namdyn ) 494 ! 495 IF(lwp) THEN ! control print 496 WRITE(numout,*) 497 WRITE(numout,*) 'namdyn : offline dynamical selection' 498 WRITE(numout,*) '~~~~~~~' 499 WRITE(numout,*) ' Namelist namdyn : set parameters for the lecture of the dynamical fields' 500 WRITE(numout,*) 501 WRITE(numout,*) ' number of elements in the FILE for a year ndtadyn = ' , ndtadyn 502 WRITE(numout,*) ' total number of elements in the FILE ndtatot = ' , ndtatot 503 WRITE(numout,*) ' type of interpolation nsptint = ' , nsptint 504 WRITE(numout,*) ' loop on the same FILE lperdyn = ' , lperdyn 505 WRITE(numout,*) ' ' 506 WRITE(numout,*) ' name of grid_T file cfile_grid_T = ', TRIM(cfile_grid_T) 507 WRITE(numout,*) ' name of grid_U file cfile_grid_U = ', TRIM(cfile_grid_U) 508 WRITE(numout,*) ' name of grid_V file cfile_grid_V = ', TRIM(cfile_grid_V) 509 WRITE(numout,*) ' name of grid_W file cfile_grid_W = ', TRIM(cfile_grid_W) 510 WRITE(numout,*) ' ' 511 ENDIF 512 ! 513 znspyr = nyear_len(1) * rday / rdt 514 rnspdta = znspyr / REAL( ndtadyn, wp ) 515 rnspdta2 = rnspdta * 0.5 375 jf_ahu = 12 ; jf_ahv = 13 ; jf_ahw = 14 ; jfld = 14 376 slf_d(jf_ahu) = sn_ahu ; slf_d(jf_ahv) = sn_ahv ; slf_d(jf_ahw) = sn_ahw 377 IF( lk_traldf_eiv .AND. ln_dynbbl ) THEN ! eiv & bbl 378 jf_ubl = 15 ; jf_vbl = 16 379 slf_d(jf_ubl) = sn_ubl ; slf_d(jf_vbl) = sn_vbl 380 jf_eiu = 17 ; jf_eiv = 18 ; jf_eiw = 19 ; jfld = 19 381 slf_d(jf_eiu) = sn_eiu ; slf_d(jf_eiv) = sn_eiv ; slf_d(jf_eiw) = sn_eiw 382 ENDIF 383 IF( .NOT.lk_traldf_eiv .AND. ln_dynbbl ) THEN ! no eiv & bbl 384 jf_ubl = 15 ; jf_vbl = 16 ; jfld = 16 385 slf_d(jf_ubl) = sn_ubl ; slf_d(jf_vbl) = sn_vbl 386 ENDIF 387 IF( lk_traldf_eiv .AND. .NOT.ln_dynbbl ) THEN ! eiv & no bbl 388 jf_eiu = 15 ; jf_eiv = 16 ; jf_eiw = 17 ; jfld = 17 389 slf_d(jf_eiu) = sn_eiu ; slf_d(jf_eiv) = sn_eiv ; slf_d(jf_eiw) = sn_eiw 390 ENDIF 391 ENDIF 392 393 ALLOCATE( sf_dyn(jfld), STAT=ierr ) ! set sf structure 394 IF( ierr > 0 ) THEN 395 CALL ctl_stop( 'dta_dyn: unable to allocate sf structure' ) ; RETURN 396 ENDIF 397 ! Open file for each variable to get his number of dimension 398 DO ifpr = 1, jfld 399 CALL iom_open( slf_d(ifpr)%clname, inum ) 400 idv = iom_varid( inum , slf_d(ifpr)%clvar ) ! id of the variable sdjf%clvar 401 idimv = iom_file ( inum )%ndims(idv) ! number of dimension for variable sdjf%clvar 402 IF( inum /= 0 ) CALL iom_close( inum ) ! close file if already open 403 IF( idimv == 3 ) THEN ! 2D variable 404 ALLOCATE( sf_dyn(ifpr)%fnow(jpi,jpj,1) , STAT=ierr0 ) 405 IF( slf_d(ifpr)%ln_tint ) ALLOCATE( sf_dyn(ifpr)%fdta(jpi,jpj,1,2) , STAT=ierr1 ) 406 ELSE ! 3D variable 407 ALLOCATE( sf_dyn(ifpr)%fnow(jpi,jpj,jpk) , STAT=ierr0 ) 408 IF( slf_d(ifpr)%ln_tint ) ALLOCATE( sf_dyn(ifpr)%fdta(jpi,jpj,jpk,2), STAT=ierr1 ) 409 ENDIF 410 IF( ierr0 + ierr1 > 0 ) THEN 411 CALL ctl_stop( 'dta_dyn_init : unable to allocate sf_dyn array structure' ) ; RETURN 412 ENDIF 413 END DO 414 ! ! fill sf with slf_i and control print 415 CALL fld_fill( sf_dyn, slf_d, cn_dir, 'dta_dyn_init', 'Data in file', 'namdta_dyn' ) 416 ! 417 IF( lk_ldfslp ) THEN ! slopes 418 IF( sf_dyn(jf_tem)%ln_tint ) THEN ! time interpolation 419 ALLOCATE( uslpdta (jpi,jpj,jpk,2), vslpdta (jpi,jpj,jpk,2), & 420 & wslpidta(jpi,jpj,jpk,2), wslpjdta(jpi,jpj,jpk,2), STAT=ierr2 ) 421 ELSE 422 ALLOCATE( uslpnow (jpi,jpj,jpk) , vslpnow (jpi,jpj,jpk) , & 423 & wslpinow(jpi,jpj,jpk) , wslpjnow(jpi,jpj,jpk) , STAT=ierr2 ) 424 ENDIF 425 IF( ierr2 > 0 ) THEN 426 CALL ctl_stop( 'dta_dyn_init : unable to allocate slope arrays' ) ; RETURN 427 ENDIF 428 ENDIF 429 IF( ln_dynwzv ) THEN ! slopes 430 IF( sf_dyn(jf_uwd)%ln_tint ) THEN ! time interpolation 431 ALLOCATE( wdta(jpi,jpj,jpk,2), STAT=ierr3 ) 432 ELSE 433 ALLOCATE( wnow(jpi,jpj,jpk) , STAT=ierr3 ) 434 ENDIF 435 IF( ierr3 > 0 ) THEN 436 CALL ctl_stop( 'dta_dyn_init : unable to allocate wdta arrays' ) ; RETURN 437 ENDIF 438 ENDIF 439 ! 440 nrecprev_tem = 0 441 nrecprev_uwd = 0 516 442 ! 517 443 CALL dta_dyn( nit000 ) … … 519 445 END SUBROUTINE dta_dyn_init 520 446 521 522 SUBROUTINE wzv( pu, pv, pw ) 447 SUBROUTINE dta_dyn_wzv( pu, pv, pw ) 523 448 !!---------------------------------------------------------------------- 524 449 !! *** ROUTINE wzv *** … … 534 459 !! The boundary conditions are w=0 at the bottom (no flux). 535 460 !!---------------------------------------------------------------------- 461 USE oce, ONLY: zhdiv => hdivn 462 ! 536 463 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pu, pv !: horizontal velocities 537 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out) :: pw !: vertic lavelocity464 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out) :: pw !: vertical velocity 538 465 !! 539 466 INTEGER :: ji, jj, jk 540 467 REAL(wp) :: zu, zu1, zv, zv1, zet 541 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zhdiv !: horizontal divergence542 468 !!---------------------------------------------------------------------- 543 469 ! 544 470 ! Computation of vertical velocity using horizontal divergence 545 zhdiv(:,:,:) = 0. 471 zhdiv(:,:,:) = 0._wp 546 472 DO jk = 1, jpkm1 547 473 DO jj = 2, jpjm1 … … 564 490 END DO 565 491 ! 566 END SUBROUTINE wzv 567 568 569 SUBROUTINE dta_eiv( kt ) 570 !!---------------------------------------------------------------------- 571 !! *** ROUTINE dta_eiv *** 572 !! 573 !! ** Purpose : Compute the eddy induced velocity coefficient from the 574 !! growth rate of baroclinic instability. 575 !! 576 !! ** Method : Specific to the offline model. Computes the horizontal 577 !! values from the vertical value 578 !!---------------------------------------------------------------------- 579 INTEGER, INTENT( in ) :: kt ! ocean time-step inedx 580 !! 581 INTEGER :: ji, jj ! dummy loop indices 582 !!---------------------------------------------------------------------- 583 ! 584 IF( kt == nit000 ) THEN 585 IF(lwp) WRITE(numout,*) 586 IF(lwp) WRITE(numout,*) 'dta_eiv : eddy induced velocity coefficients' 587 IF(lwp) WRITE(numout,*) '~~~~~~~' 588 ENDIF 589 ! 590 #if defined key_ldfeiv 591 ! Average the diffusive coefficient at u- v- points 592 DO jj = 2, jpjm1 593 DO ji = fs_2, fs_jpim1 ! vector opt. 594 aeiu(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji+1,jj ) ) 595 aeiv(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji ,jj+1) ) 596 END DO 597 END DO 598 CALL lbc_lnk( aeiu, 'U', 1. ) ; CALL lbc_lnk( aeiv, 'V', 1. ) ! lateral boundary condition 492 END SUBROUTINE dta_dyn_wzv 493 494 SUBROUTINE dta_dyn_slp( kt, pts, puslp, pvslp, pwslpi, pwslpj ) 495 !!--------------------------------------------------------------------- 496 !! *** ROUTINE dta_dyn_slp *** 497 !! 498 !! ** Purpose : Computation of slope 499 !! 500 !!--------------------------------------------------------------------- 501 INTEGER , INTENT(in ) :: kt ! time step 502 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! temperature/salinity 503 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(out) :: puslp ! zonal isopycnal slopes 504 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(out) :: pvslp ! meridional isopycnal slopes 505 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(out) :: pwslpi ! zonal diapycnal slopes 506 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(out) :: pwslpj ! meridional diapycnal slopes 507 !! 508 #if defined key_ldfslp && ! defined key_c1d 509 CALL eos( pts, rhd, rhop ) ! Time-filtered in situ density 510 CALL bn2( pts, rn2 ) ! before Brunt-Vaisala frequency 511 IF( ln_zps ) & 512 & CALL zps_hde( kt, jpts, pts, gtsu, gtsv, rhd, gru, grv ) ! Partial steps: before Horizontal DErivative 513 ! ! of t, s, rd at the bottom ocean level 514 CALL zdf_mxl( kt ) ! mixed layer depth 515 CALL ldf_slp( kt, rhd, rn2 ) ! slopes 516 puslp (:,:,:) = uslp (:,:,:) 517 pvslp (:,:,:) = vslp (:,:,:) 518 pwslpi(:,:,:) = wslpi(:,:,:) 519 pwslpj(:,:,:) = wslpj(:,:,:) 520 #else 521 WRITE(*,*) 'dta_dyn_slp: You should not have seen this print! error?', & 522 & kt, pts(1,1,1,1),puslp(1,1,1), pvslp(1,1,1), pwslpi(1,1,1), pwslpj(1,1,1) 599 523 #endif 600 524 ! 601 END SUBROUTINE dta_eiv 602 603 604 SUBROUTINE tau2wnd( ptaux, ptauy, pwspd ) 605 !!--------------------------------------------------------------------- 606 !! *** ROUTINE sbc_tau2wnd *** 607 !! 608 !! ** Purpose : Estimation of wind speed as a function of wind stress 609 !! 610 !! ** Method : |tau|=rhoa*Cd*|U|^2 611 !!--------------------------------------------------------------------- 612 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: ptaux, ptauy ! wind stress in i-j direction resp. 613 REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: pwspd ! wind speed 614 !! 615 REAL(wp) :: zrhoa = 1.22_wp ! Air density kg/m3 616 REAL(wp) :: zcdrag = 1.5e-3_wp ! drag coefficient 617 REAL(wp) :: ztx, zty, ztau, zcoef ! temporary variables 618 INTEGER :: ji, jj ! dummy indices 619 !!--------------------------------------------------------------------- 620 zcoef = 1. / ( zrhoa * zcdrag ) 621 !CDIR NOVERRCHK 622 DO jj = 2, jpjm1 623 !CDIR NOVERRCHK 624 DO ji = fs_2, fs_jpim1 ! vector opt. 625 ztx = ptaux(ji,jj) * umask(ji,jj,1) + ptaux(ji-1,jj ) * umask(ji-1,jj ,1) 626 zty = ptauy(ji,jj) * vmask(ji,jj,1) + ptauy(ji ,jj-1) * vmask(ji ,jj-1,1) 627 ztau = 0.5 * SQRT( ztx * ztx + zty * zty ) 628 pwspd(ji,jj) = SQRT ( ztau * zcoef ) * tmask(ji,jj,1) 629 END DO 630 END DO 631 CALL lbc_lnk( pwspd(:,:), 'T', 1. ) 632 ! 633 END SUBROUTINE tau2wnd 634 635 636 SUBROUTINE swap_dyn_data 637 !!---------------------------------------------------------------------- 638 !! *** ROUTINE swap_dyn_data *** 639 !! 640 !! ** Purpose : swap array data 641 !!---------------------------------------------------------------------- 642 ! 643 ! swap from record 2 to 1 644 tdta (:,:,:,1) = tdta (:,:,:,2) 645 sdta (:,:,:,1) = sdta (:,:,:,2) 646 avtdta (:,:,:,1) = avtdta (:,:,:,2) 647 udta (:,:,:,1) = udta (:,:,:,2) 648 vdta (:,:,:,1) = vdta (:,:,:,2) 649 wdta (:,:,:,1) = wdta (:,:,:,2) 650 #if defined key_ldfslp && ! defined key_c1d 651 uslpdta (:,:,:,1) = uslpdta (:,:,:,2) 652 vslpdta (:,:,:,1) = vslpdta (:,:,:,2) 653 wslpidta(:,:,:,1) = wslpidta(:,:,:,2) 654 wslpjdta(:,:,:,1) = wslpjdta(:,:,:,2) 655 #endif 656 hmlddta(:,:,1) = hmlddta(:,:,2) 657 wspddta(:,:,1) = wspddta(:,:,2) 658 frlddta(:,:,1) = frlddta(:,:,2) 659 empdta (:,:,1) = empdta (:,:,2) 660 qsrdta (:,:,1) = qsrdta (:,:,2) 661 IF( l_offbbl ) THEN 662 bblxdta(:,:,1) = bblxdta(:,:,2) 663 bblydta(:,:,1) = bblydta(:,:,2) 664 ENDIF 665 666 #if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv 667 aeiwdta(:,:,1) = aeiwdta(:,:,2) 668 #endif 669 670 #if defined key_degrad 671 ahtudta(:,:,:,1) = ahtudta(:,:,:,2) 672 ahtvdta(:,:,:,1) = ahtvdta(:,:,:,2) 673 ahtwdta(:,:,:,1) = ahtwdta(:,:,:,2) 674 # if defined key_traldf_eiv 675 aeiudta(:,:,:,1) = aeiudta(:,:,:,2) 676 aeivdta(:,:,:,1) = aeivdta(:,:,:,2) 677 aeiwdta(:,:,:,1) = aeiwdta(:,:,:,2) 678 # endif 679 #endif 680 ! 681 END SUBROUTINE swap_dyn_data 682 683 684 SUBROUTINE assign_dyn_data 685 !!---------------------------------------------------------------------- 686 !! *** ROUTINE assign_dyn_data *** 687 !! 688 !! ** Purpose : Assign dynamical data to the data that have been read 689 !! without time interpolation 690 !! 691 !!---------------------------------------------------------------------- 692 693 tsn(:,:,:,jp_tem) = tdta (:,:,:,2) 694 tsn(:,:,:,jp_sal) = sdta (:,:,:,2) 695 avt(:,:,:) = avtdta(:,:,:,2) 696 697 un (:,:,:) = udta (:,:,:,2) 698 vn (:,:,:) = vdta (:,:,:,2) 699 wn (:,:,:) = wdta (:,:,:,2) 700 701 #if defined key_ldfslp && ! defined key_c1d 702 uslp (:,:,:) = uslpdta (:,:,:,2) 703 vslp (:,:,:) = vslpdta (:,:,:,2) 704 wslpi(:,:,:) = wslpidta(:,:,:,2) 705 wslpj(:,:,:) = wslpjdta(:,:,:,2) 706 #endif 707 708 hmld(:,:) = hmlddta(:,:,2) 709 wndm(:,:) = wspddta(:,:,2) 710 fr_i(:,:) = frlddta(:,:,2) 711 emp (:,:) = empdta (:,:,2) 712 emps(:,:) = emp(:,:) 713 qsr (:,:) = qsrdta (:,:,2) 714 #if defined key_trabbl 715 IF( l_offbbl ) THEN 716 ahu_bbl(:,:) = bblxdta(:,:,2) 717 ahv_bbl(:,:) = bblydta(:,:,2) 718 ENDIF 719 #endif 720 #if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv 721 aeiw(:,:) = aeiwdta(:,:,2) 722 #endif 723 724 #if defined key_degrad 725 ahtu(:,:,:) = ahtudta(:,:,:,2) 726 ahtv(:,:,:) = ahtvdta(:,:,:,2) 727 ahtw(:,:,:) = ahtwdta(:,:,:,2) 728 # if defined key_traldf_eiv 729 aeiu(:,:,:) = aeiudta(:,:,:,2) 730 aeiv(:,:,:) = aeivdta(:,:,:,2) 731 aeiw(:,:,:) = aeiwdta(:,:,:,2) 732 # endif 733 #endif 734 ! 735 END SUBROUTINE assign_dyn_data 736 737 738 SUBROUTINE linear_interp_dyn_data( pweigh ) 739 !!---------------------------------------------------------------------- 740 !! *** ROUTINE linear_interp_dyn_data *** 741 !! 742 !! ** Purpose : linear interpolation of data 743 !!---------------------------------------------------------------------- 744 REAL(wp), INTENT(in) :: pweigh ! weigh 745 !! 746 REAL(wp) :: zweighm1 747 !!---------------------------------------------------------------------- 748 749 zweighm1 = 1. - pweigh 750 751 tsn(:,:,:,jp_tem) = zweighm1 * tdta (:,:,:,1) + pweigh * tdta (:,:,:,2) 752 tsn(:,:,:,jp_sal) = zweighm1 * sdta (:,:,:,1) + pweigh * sdta (:,:,:,2) 753 avt(:,:,:) = zweighm1 * avtdta(:,:,:,1) + pweigh * avtdta(:,:,:,2) 754 755 un (:,:,:) = zweighm1 * udta (:,:,:,1) + pweigh * udta (:,:,:,2) 756 vn (:,:,:) = zweighm1 * vdta (:,:,:,1) + pweigh * vdta (:,:,:,2) 757 wn (:,:,:) = zweighm1 * wdta (:,:,:,1) + pweigh * wdta (:,:,:,2) 758 759 #if defined key_ldfslp && ! defined key_c1d 760 uslp (:,:,:) = zweighm1 * uslpdta (:,:,:,1) + pweigh * uslpdta (:,:,:,2) 761 vslp (:,:,:) = zweighm1 * vslpdta (:,:,:,1) + pweigh * vslpdta (:,:,:,2) 762 wslpi(:,:,:) = zweighm1 * wslpidta(:,:,:,1) + pweigh * wslpidta(:,:,:,2) 763 wslpj(:,:,:) = zweighm1 * wslpjdta(:,:,:,1) + pweigh * wslpjdta(:,:,:,2) 764 #endif 765 766 hmld(:,:) = zweighm1 * hmlddta(:,:,1) + pweigh * hmlddta(:,:,2) 767 wndm(:,:) = zweighm1 * wspddta(:,:,1) + pweigh * wspddta(:,:,2) 768 fr_i(:,:) = zweighm1 * frlddta(:,:,1) + pweigh * frlddta(:,:,2) 769 emp (:,:) = zweighm1 * empdta (:,:,1) + pweigh * empdta (:,:,2) 770 emps(:,:) = emp(:,:) 771 qsr (:,:) = zweighm1 * qsrdta (:,:,1) + pweigh * qsrdta (:,:,2) 772 #if defined key_trabbl 773 IF( l_offbbl ) THEN 774 ahu_bbl(:,:) = zweighm1 * bblxdta(:,:,1) + pweigh * bblxdta(:,:,2) 775 ahv_bbl(:,:) = zweighm1 * bblydta(:,:,1) + pweigh * bblydta(:,:,2) 776 ENDIF 777 #endif 778 779 #if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv 780 aeiw(:,:) = zweighm1 * aeiwdta(:,:,1) + pweigh * aeiwdta(:,:,2) 781 #endif 782 783 #if defined key_degrad 784 ahtu(:,:,:) = zweighm1 * ahtudta(:,:,:,1) + pweigh * ahtudta(:,:,:,2) 785 ahtv(:,:,:) = zweighm1 * ahtvdta(:,:,:,1) + pweigh * ahtvdta(:,:,:,2) 786 ahtw(:,:,:) = zweighm1 * ahtwdta(:,:,:,1) + pweigh * ahtwdta(:,:,:,2) 787 # if defined key_traldf_eiv 788 aeiu(:,:,:) = zweighm1 * aeiudta(:,:,:,1) + pweigh * aeiudta(:,:,:,2) 789 aeiv(:,:,:) = zweighm1 * aeivdta(:,:,:,1) + pweigh * aeivdta(:,:,:,2) 790 aeiw(:,:,:) = zweighm1 * aeiwdta(:,:,:,1) + pweigh * aeiwdta(:,:,:,2) 791 # endif 792 #endif 793 ! 794 END SUBROUTINE linear_interp_dyn_data 795 525 END SUBROUTINE dta_dyn_slp 796 526 !!====================================================================== 797 527 END MODULE dtadyn -
branches/2011/dev_r2787_LOCEAN_offline_fldread/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90
r2715 r2821 25 25 REAL(wp), PUBLIC :: r_si2 !: largest depth of extinction (blue & 0.01 mg.m-3) (RGB) 26 26 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: etot3 !: light absortion coefficient 27 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: facvol !: volume for degraded regions 27 28 28 29 #if defined key_top && defined key_pisces … … 48 49 !!---------------------------------------------------------------------- 49 50 LOGICAL, PUBLIC, PARAMETER :: lk_offline = .FALSE. !: offline flag 51 #endif 52 #if defined key_degrad 53 !!---------------------------------------------------------------------- 54 !! 'key_degrad' Degradation mode 55 !!---------------------------------------------------------------------- 56 LOGICAL, PUBLIC, PARAMETER :: lk_degrad = .TRUE. !: degradation flag 57 #else 58 !!---------------------------------------------------------------------- 59 !! Default option NO Degradation mode 60 !!---------------------------------------------------------------------- 61 LOGICAL, PUBLIC, PARAMETER :: lk_degrad = .FALSE. !: degradation flag 50 62 #endif 51 63 … … 63 75 !! *** trc_oce_alloc *** 64 76 !!---------------------------------------------------------------------- 65 ALLOCATE( etot3(jpi,jpj,jpk) , STAT= trc_oce_alloc ) 77 INTEGER :: ierr(2) ! Local variables 78 !!---------------------------------------------------------------------- 79 ierr(:) = 0 80 ALLOCATE( etot3 (jpi,jpj,jpk), STAT=ierr(1) ) 81 IF( lk_degrad) ALLOCATE( facvol(jpi,jpj,jpk), STAT=ierr(2) ) 82 trc_oce_alloc = MAXVAL( ierr ) 66 83 ! 67 84 IF( trc_oce_alloc /= 0 ) CALL ctl_warn('trc_oce_alloc: failed to allocate etot3 array') -
branches/2011/dev_r2787_LOCEAN_offline_fldread/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90
r2787 r2821 198 198 USE oce , ONLY : gru => gru !: 199 199 USE oce , ONLY : grv => grv !: 200 # if defined key_degrad201 USE dommsk , ONLY : facvol => facvol !: volume factor for degradation202 # endif203 204 200 #endif 205 201
Note: See TracChangeset
for help on using the changeset viewer.
