Changeset 3294 for trunk/NEMOGCM/NEMO/OFF_SRC
- Timestamp:
- 2012-01-28T17:44:18+01:00 (12 years ago)
- Location:
- trunk/NEMOGCM/NEMO/OFF_SRC
- Files:
-
- 4 edited
-
dommsk.F90 (modified) (4 diffs)
-
domrea.F90 (modified) (7 diffs)
-
dtadyn.F90 (modified) (9 diffs)
-
nemogcm.F90 (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OFF_SRC/dommsk.F90
r2715 r3294 14 14 USE lib_mpp ! MPP library 15 15 USE in_out_manager ! I/O manager 16 USE wrk_nemo 16 17 17 18 IMPLICIT NONE … … 20 21 PUBLIC dom_msk ! routine called by inidom.F90 21 22 22 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: facvol !: volume for degraded regions 23 REAL(wp) :: rn_shlat = 2. ! type of lateral boundary condition on velocity 24 LOGICAL, PUBLIC :: ln_vorlat = .false. ! consistency of vorticity boundary condition 23 25 24 26 !! * Substitutions … … 45 47 !! tpol : ??? 46 48 !!---------------------------------------------------------------------- 47 USE wrk_nemo, ONLY: iwrk_in_use, iwrk_not_released48 USE wrk_nemo, ONLY: imsk => iwrk_2d_149 49 ! 50 50 INTEGER :: ji, jk ! dummy loop indices 51 51 INTEGER :: iif, iil, ijf, ijl ! local integers 52 INTEGER, POINTER, DIMENSION(:,:) :: imsk 53 ! 52 54 !!--------------------------------------------------------------------- 55 56 CALL wrk_alloc( jpi, jpj, imsk ) 53 57 ! 54 IF( iwrk_in_use(2, 1) ) THEN55 CALL ctl_stop('dom_msk: requested workspace arrays unavailable') ; RETURN56 END IF57 !58 #if defined key_degrad59 IF( dom_msk_alloc() /= 0 ) CALL ctl_stop('STOP','dom_msk: unable to allocate arrays')60 #endif61 62 58 ! Interior domain mask (used for global sum) 63 59 ! -------------------- … … 101 97 ENDIF 102 98 ! 103 IF( iwrk_not_released(2, 1) ) CALL ctl_stop('dom_msk: failed to release workspace arrays')99 CALL wrk_dealloc( jpi, jpj, imsk ) 104 100 ! 105 101 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 102 !!====================================================================== 118 103 END MODULE dommsk -
trunk/NEMOGCM/NEMO/OFF_SRC/domrea.F90
r2787 r3294 16 16 USE dommsk ! domain: masks 17 17 USE lbclnk ! lateral boundary condition - MPP exchanges 18 USE trc_oce ! shared ocean/biogeochemical variables 18 19 USE lib_mpp 19 20 USE in_out_manager 20 USE wrk_nemo , ONLY: wrk_in_use, wrk_not_released21 USE wrk_nemo 21 22 22 23 IMPLICIT NONE … … 55 56 !!---------------------------------------------------------------------- 56 57 USE iom 57 USE wrk_nemo, ONLY: zmbk => wrk_2d_1, zprt => wrk_2d_2, zprw => wrk_2d_358 58 !! 59 59 INTEGER :: ji, jj, jk ! dummy loop indices 60 60 INTEGER :: ik, inum0 , inum1 , inum2 , inum3 , inum4 ! local integers 61 61 REAL(wp) :: zrefdep ! local real 62 REAL(wp), POINTER, DIMENSION(:,:) :: zmbk, zprt, zprw 62 63 !!---------------------------------------------------------------------- 63 64 … … 66 67 IF(lwp) WRITE(numout,*) '~~~~~~~' 67 68 68 IF( wrk_in_use(2, 1,2,3) ) THEN 69 CALL ctl_stop('dom_rea: ERROR: requested workspace arrays unavailable.') ; RETURN 70 END IF 69 CALL wrk_alloc( jpi, jpj, zmbk, zprt, zprw ) 71 70 72 71 zmbk(:,:) = 0._wp … … 330 329 END SELECT 331 330 ! 332 IF( wrk_not_released(2, 1,2,3) ) CALL ctl_stop('dom_rea:failed to release workspace arrays.')331 CALL wrk_dealloc( jpi, jpj, zmbk, zprt, zprw ) 333 332 ! 334 333 END SUBROUTINE dom_rea … … 345 344 !! ** Action : - update mbathy: level bathymetry (in level index) 346 345 !!---------------------------------------------------------------------- 347 USE wrk_nemo, ONLY: zmbk => wrk_2d_4348 346 ! 349 347 INTEGER :: ji, jj ! dummy loop indices 348 REAL(wp), POINTER, DIMENSION(:,:) :: zmbk 350 349 !!---------------------------------------------------------------------- 351 350 … … 355 354 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~' 356 355 ! 357 IF( wrk_in_use(2, 4) ) THEN 358 CALL ctl_stop('dom_rea: ERROR: requested workspace arrays unavailable.') ; RETURN 359 END IF 356 CALL wrk_alloc( jpi, jpj, zmbk ) 360 357 ! 361 358 mbkt(:,:) = MAX( mbathy(:,:) , 1 ) ! bottom k-index of T-level (=1 over land) … … 371 368 zmbk(:,:) = REAL( mbkv(:,:), wp ) ; CALL lbc_lnk(zmbk,'V',1.) ; mbkv (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 372 369 ! 373 IF( wrk_not_released(2, 4) ) CALL ctl_stop('dom_rea:failed to release workspace arrays.')370 CALL wrk_dealloc( jpi, jpj, zmbk ) 374 371 ! 375 372 END SUBROUTINE zgr_bot_level -
trunk/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90
r2764 r3294 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 41 USE timing ! Timing 39 42 40 43 IMPLICIT NONE … … 44 47 PUBLIC dta_dyn ! called by step.F90 45 48 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 49 CHARACTER(len=100) :: cn_dir = './' !: Root directory for location of ssr files 50 LOGICAL :: ln_dynwzv = .true. !: vertical velocity read in a file (T) or computed from u/v (F) 51 LOGICAL :: ln_dynbbl = .true. !: bbl coef read in a file (T) or computed (F) 52 LOGICAL :: ln_degrad = .false. !: degradation option enabled or not 53 54 INTEGER , PARAMETER :: jpfld = 19 ! maximum number of files to read 55 INTEGER , SAVE :: jf_tem ! index of temperature 56 INTEGER , SAVE :: jf_sal ! index of salinity 57 INTEGER , SAVE :: jf_uwd ! index of u-wind 58 INTEGER , SAVE :: jf_vwd ! index of v-wind 59 INTEGER , SAVE :: jf_wwd ! index of w-wind 60 INTEGER , SAVE :: jf_avt ! index of Kz 61 INTEGER , SAVE :: jf_mld ! index of mixed layer deptht 62 INTEGER , SAVE :: jf_emp ! index of water flux 63 INTEGER , SAVE :: jf_qsr ! index of solar radiation 64 INTEGER , SAVE :: jf_wnd ! index of wind speed 65 INTEGER , SAVE :: jf_ice ! index of sea ice cover 66 INTEGER , SAVE :: jf_ubl ! index of u-bbl coef 67 INTEGER , SAVE :: jf_vbl ! index of v-bbl coef 68 INTEGER , SAVE :: jf_ahu ! index of u-diffusivity coef 69 INTEGER , SAVE :: jf_ahv ! index of v-diffusivity coef 70 INTEGER , SAVE :: jf_ahw ! index of w-diffusivity coef 71 INTEGER , SAVE :: jf_eiu ! index of u-eiv 72 INTEGER , SAVE :: jf_eiv ! index of v-eiv 73 INTEGER , SAVE :: jf_eiw ! index of w-eiv 74 75 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_dyn ! structure of input fields (file informations, fields read) 76 ! ! 77 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wdta ! vertical velocity at 2 time step 78 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,: ) :: wnow ! vertical velocity at 2 time step 79 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: uslpdta ! zonal isopycnal slopes 80 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: vslpdta ! meridional isopycnal slopes 81 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wslpidta ! zonal diapycnal slopes 82 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wslpjdta ! meridional diapycnal slopes 83 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uslpnow ! zonal isopycnal slopes 84 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: vslpnow ! meridional isopycnal slopes 85 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wslpinow ! zonal diapycnal slopes 86 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wslpjnow ! meridional diapycnal slopes 87 88 INTEGER :: nrecprev_tem , nrecprev_uwd 95 89 96 90 !! * Substitutions … … 108 102 !! *** ROUTINE dta_dyn *** 109 103 !! 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 !!---------------------------------------------------------------------- 104 !! ** Purpose : Prepares dynamics and physics fields from a NEMO run 105 !! for an off-line simulation of passive tracers 106 !! 107 !! ** Method : calculates the position of data 108 !! - computes slopes if needed 109 !! - interpolates data if needed 110 !!---------------------------------------------------------------------- 111 ! 112 USE oce, ONLY: zts => tsa 113 USE oce, ONLY: zuslp => ua , zvslp => va 114 USE oce, ONLY: zwslpi => rotb , zwslpj => rotn 115 USE oce, ONLY: zu => ub , zv => vb, zw => hdivb 116 ! 117 117 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 118 ! 119 INTEGER :: ji, jj ! dummy loop indices 120 INTEGER :: isecsbc ! number of seconds between Jan. 1st 00h of nit000 year and the middle of time step 121 REAL(wp) :: ztinta ! ratio applied to after records when doing time interpolation 122 REAL(wp) :: ztintb ! ratio applied to before records when doing time interpolation 123 INTEGER :: iswap_tem, iswap_uwd ! 124 !!---------------------------------------------------------------------- 125 126 ! 127 IF( nn_timing == 1 ) CALL timing_start( 'dta_dyn') 128 ! 129 isecsbc = nsec_year + nsec1jan000 130 ! 131 IF( kt == nit000 ) THEN 132 nrecprev_tem = 0 133 nrecprev_uwd = 0 158 134 ! 159 CALL dynrea( kt, MAX( 1, iperm1) ) ! data read for the iperm1 period135 CALL fld_read( kt, 1, sf_dyn ) !== read data at kt time step ==! 160 136 ! 161 CALL swap_dyn_data ! swap from record 2 to 1 137 IF( lk_ldfslp .AND. .NOT.lk_c1d .AND. sf_dyn(jf_tem)%ln_tint ) THEN ! Computes slopes (here avt is used as workspace) 138 zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:,1) * tmask(:,:,:) ! temperature 139 zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,1) * tmask(:,:,:) ! salinity 140 avt(:,:,:) = sf_dyn(jf_avt)%fdta(:,:,:,1) * tmask(:,:,:) ! vertical diffusive coef. 141 CALL dta_dyn_slp( kt, zts, zuslp, zvslp, zwslpi, zwslpj ) 142 uslpdta (:,:,:,1) = zuslp (:,:,:) 143 vslpdta (:,:,:,1) = zvslp (:,:,:) 144 wslpidta(:,:,:,1) = zwslpi(:,:,:) 145 wslpjdta(:,:,:,1) = zwslpj(:,:,:) 146 ENDIF 147 IF( ln_dynwzv .AND. sf_dyn(jf_uwd)%ln_tint ) THEN ! compute vertical velocity from u/v 148 zu(:,:,:) = sf_dyn(jf_uwd)%fdta(:,:,:,1) 149 zv(:,:,:) = sf_dyn(jf_vwd)%fdta(:,:,:,1) 150 CALL dta_dyn_wzv( zu, zv, zw ) 151 wdta(:,:,:,1) = zw(:,:,:) * tmask(:,:,:) 152 ENDIF 153 ELSE 154 nrecprev_tem = sf_dyn(jf_tem)%nrec_a(2) 155 nrecprev_uwd = sf_dyn(jf_uwd)%nrec_a(2) 162 156 ! 163 iswap = 1 ! indicates swap157 CALL fld_read( kt, 1, sf_dyn ) !== read data at kt time step ==! 164 158 ! 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 ' 159 ENDIF 160 ! 161 IF( lk_ldfslp .AND. .NOT.lk_c1d ) THEN ! Computes slopes (here avt is used as workspace) 162 iswap_tem = 0 163 IF( kt /= nit000 .AND. ( sf_dyn(jf_tem)%nrec_a(2) - nrecprev_tem ) /= 0 ) iswap_tem = 1 164 IF( ( isecsbc > sf_dyn(jf_tem)%nrec_b(2) .AND. iswap_tem == 1 ) .OR. kt == nit000 ) THEN ! read/update the after data 165 write(numout,*) 166 write(numout,*) ' Compute new slopes at kt = ', kt 167 IF( sf_dyn(jf_tem)%ln_tint ) THEN ! time interpolation of data 168 IF( kt /= nit000 ) THEN 169 uslpdta (:,:,:,1) = uslpdta (:,:,:,2) ! swap the data 170 vslpdta (:,:,:,1) = vslpdta (:,:,:,2) 171 wslpidta(:,:,:,1) = wslpidta(:,:,:,2) 172 wslpjdta(:,:,:,1) = wslpjdta(:,:,:,2) 173 ENDIF 174 ! 175 zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:,2) * tmask(:,:,:) ! temperature 176 zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,2) * tmask(:,:,:) ! salinity 177 avt(:,:,:) = sf_dyn(jf_avt)%fdta(:,:,:,2) * tmask(:,:,:) ! vertical diffusive coef. 178 CALL dta_dyn_slp( kt, zts, zuslp, zvslp, zwslpi, zwslpj ) 179 ! 180 uslpdta (:,:,:,2) = zuslp (:,:,:) 181 vslpdta (:,:,:,2) = zvslp (:,:,:) 182 wslpidta(:,:,:,2) = zwslpi(:,:,:) 183 wslpjdta(:,:,:,2) = zwslpj(:,:,:) 184 ELSE 185 zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fnow(:,:,:) * tmask(:,:,:) 186 zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fnow(:,:,:) * tmask(:,:,:) 187 avt(:,:,:) = sf_dyn(jf_avt)%fnow(:,:,:) * tmask(:,:,:) 188 CALL dta_dyn_slp( kt, zts, zuslp, zvslp, zwslpi, zwslpj ) 189 uslpnow (:,:,:) = zuslp (:,:,:) 190 vslpnow (:,:,:) = zvslp (:,:,:) 191 wslpinow(:,:,:) = zwslpi(:,:,:) 192 wslpjnow(:,:,:) = zwslpj(:,:,:) 180 193 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 ! 194 ENDIF 195 IF( sf_dyn(jf_tem)%ln_tint ) THEN 196 ztinta = REAL( isecsbc - sf_dyn(jf_tem)%nrec_b(2), wp ) & 197 & / REAL( sf_dyn(jf_tem)%nrec_a(2) - sf_dyn(jf_tem)%nrec_b(2), wp ) 198 ztintb = 1. - ztinta 199 uslp (:,:,:) = ztintb * uslpdta (:,:,:,1) + ztinta * uslpdta (:,:,:,2) 200 vslp (:,:,:) = ztintb * vslpdta (:,:,:,1) + ztinta * vslpdta (:,:,:,2) 201 wslpi(:,:,:) = ztintb * wslpidta(:,:,:,1) + ztinta * wslpidta(:,:,:,2) 202 wslpj(:,:,:) = ztintb * wslpjdta(:,:,:,1) + ztinta * wslpjdta(:,:,:,2) 203 ELSE 204 uslp (:,:,:) = uslpnow (:,:,:) 205 vslp (:,:,:) = vslpnow (:,:,:) 206 wslpi(:,:,:) = wslpinow(:,:,:) 207 wslpj(:,:,:) = wslpjnow(:,:,:) 208 ENDIF 209 ENDIF 210 ! 211 IF( ln_dynwzv ) THEN ! compute vertical velocity from u/v 212 iswap_uwd = 0 213 IF( kt /= nit000 .AND. ( sf_dyn(jf_uwd)%nrec_a(2) - nrecprev_uwd ) /= 0 ) iswap_uwd = 1 214 IF( ( isecsbc > sf_dyn(jf_uwd)%nrec_b(2) .AND. iswap_uwd == 1 ) .OR. kt == nit000 ) THEN ! read/update the after data 215 write(numout,*) 216 write(numout,*) ' Compute new vertical velocity at kt = ', kt 217 write(numout,*) 218 IF( sf_dyn(jf_uwd)%ln_tint ) THEN ! time interpolation of data 219 IF( kt /= nit000 ) THEN 220 wdta(:,:,:,1) = wdta(:,:,:,2) ! swap the data for initialisation 221 ENDIF 222 zu(:,:,:) = sf_dyn(jf_uwd)%fdta(:,:,:,2) 223 zv(:,:,:) = sf_dyn(jf_vwd)%fdta(:,:,:,2) 224 CALL dta_dyn_wzv( zu, zv, zw ) 225 wdta(:,:,:,2) = zw(:,:,:) * tmask(:,:,:) 226 ELSE 227 zu(:,:,:) = sf_dyn(jf_uwd)%fnow(:,:,:) 228 zv(:,:,:) = sf_dyn(jf_vwd)%fnow(:,:,:) 229 CALL dta_dyn_wzv( zu, zv, zw ) 230 wnow(:,:,:) = zw(:,:,:) * tmask(:,:,:) 231 ENDIF 232 ENDIF 233 IF( sf_dyn(jf_uwd)%ln_tint ) THEN 234 ztinta = REAL( isecsbc - sf_dyn(jf_uwd)%nrec_b(2), wp ) & 235 & / REAL( sf_dyn(jf_uwd)%nrec_a(2) - sf_dyn(jf_uwd)%nrec_b(2), wp ) 236 ztintb = 1. - ztinta 237 wn(:,:,:) = ztintb * wdta(:,:,:,1) + ztinta * wdta(:,:,:,2) 238 ELSE 239 wn(:,:,:) = wnow(:,:,:) 240 ENDIF 241 ENDIF 242 ! 243 tsn(:,:,:,jp_tem) = sf_dyn(jf_tem)%fnow(:,:,:) * tmask(:,:,:) ! temperature 244 tsn(:,:,:,jp_sal) = sf_dyn(jf_sal)%fnow(:,:,:) * tmask(:,:,:) ! salinity 245 ! 246 CALL eos ( tsn, rhd, rhop ) ! In any case, we need rhop 247 CALL zdf_mxl( kt ) ! In any case, we need mxl 248 ! 249 avt(:,:,:) = sf_dyn(jf_avt)%fnow(:,:,:) * tmask(:,:,:) ! vertical diffusive coefficient 250 un (:,:,:) = sf_dyn(jf_uwd)%fnow(:,:,:) * umask(:,:,:) ! u-velocity 251 vn (:,:,:) = sf_dyn(jf_vwd)%fnow(:,:,:) * vmask(:,:,:) ! v-velocity 252 IF( .NOT.ln_dynwzv ) & ! w-velocity read in file 253 wn (:,:,:) = sf_dyn(jf_wwd)%fnow(:,:,:) * tmask(:,:,:) 254 hmld(:,:) = sf_dyn(jf_mld)%fnow(:,:,1) * tmask(:,:,1) ! mixed layer depht 255 wndm(:,:) = sf_dyn(jf_wnd)%fnow(:,:,1) * tmask(:,:,1) ! wind speed - needed for gas exchange 256 emp (:,:) = sf_dyn(jf_emp)%fnow(:,:,1) * tmask(:,:,1) ! E-P 257 emps(:,:) = emp(:,:) 258 fr_i(:,:) = sf_dyn(jf_ice)%fnow(:,:,1) * tmask(:,:,1) ! Sea-ice fraction 259 qsr (:,:) = sf_dyn(jf_qsr)%fnow(:,:,1) * tmask(:,:,1) ! solar radiation 260 261 ! ! bbl diffusive coef 262 #if defined key_trabbl && ! defined key_c1d 263 IF( ln_dynbbl ) THEN ! read in a file 264 ahu_bbl(:,:) = sf_dyn(jf_ubl)%fnow(:,:,1) * umask(:,:,1) 265 ahv_bbl(:,:) = sf_dyn(jf_vbl)%fnow(:,:,1) * vmask(:,:,1) 266 ELSE ! Compute bbl coefficients if needed 267 tsb(:,:,:,:) = tsn(:,:,:,:) 268 CALL bbl( kt, nit000, 'TRC') 200 269 END IF 201 !202 ! Compute the data at the given time step203 !----------------------------------------204 205 IF( nsptint == 0 ) THEN ! No space interpolation, data are probably correct206 ! ! We have to initialize data if we have changed the period207 CALL assign_dyn_data208 ELSEIF( nsptint == 1 ) THEN ! linear interpolation209 CALL linear_interp_dyn_data( zweigh )210 ELSE ! other interpolation211 WRITE (numout,*) ' this kind of interpolation do not exist at the moment : we stop'212 STOP 'dtadyn'213 END IF214 !215 CALL eos( tsn, rhd, rhop ) ! In any case, we need rhop216 !217 #if ! defined key_degrad && defined key_traldf_c2d218 ! ! In case of 2D varying coefficients, we need aeiv and aeiu219 IF( lk_traldf_eiv ) CALL dta_eiv( kt ) ! eddy induced velocity coefficient220 270 #endif 221 ! 222 IF( .NOT. l_offbbl ) THEN ! Compute bbl coefficients if needed 223 tsb(:,:,:,:) = tsn(:,:,:,:) 224 CALL bbl( kt, 'TRC') 225 END IF 226 ! 227 IF(ln_ctl) THEN 271 #if ( ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv ) && ! defined key_c1d 272 aeiw(:,:) = sf_dyn(jf_eiw)%fnow(:,:,1) * tmask(:,:,1) ! w-eiv 273 ! ! Computes the horizontal values from the vertical value 274 DO jj = 2, jpjm1 275 DO ji = fs_2, fs_jpim1 ! vector opt. 276 aeiu(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji+1,jj ) ) ! Average the diffusive coefficient at u- v- points 277 aeiv(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji ,jj+1) ) ! at u- v- points 278 END DO 279 END DO 280 CALL lbc_lnk( aeiu, 'U', 1. ) ; CALL lbc_lnk( aeiv, 'V', 1. ) ! lateral boundary condition 281 #endif 282 283 #if defined key_degrad && ! defined key_c1d 284 ! ! degrad option : diffusive and eiv coef are 3D 285 ahtu(:,:,:) = sf_dyn(jf_ahu)%fnow(:,:,:) * umask(:,:,:) 286 ahtv(:,:,:) = sf_dyn(jf_ahv)%fnow(:,:,:) * vmask(:,:,:) 287 ahtw(:,:,:) = sf_dyn(jf_ahw)%fnow(:,:,:) * tmask(:,:,:) 288 # if defined key_traldf_eiv 289 aeiu(:,:,:) = sf_dyn(jf_eiu)%fnow(:,:,:) * umask(:,:,:) 290 aeiv(:,:,:) = sf_dyn(jf_eiv)%fnow(:,:,:) * vmask(:,:,:) 291 aeiw(:,:,:) = sf_dyn(jf_eiw)%fnow(:,:,:) * tmask(:,:,:) 292 # endif 293 #endif 294 ! 295 IF(ln_ctl) THEN ! print control 228 296 CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' tn - : ', mask1=tmask, ovlap=1, kdim=jpk ) 229 297 CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_sal), clinfo1=' sn - : ', mask1=tmask, ovlap=1, kdim=jpk ) 230 CALL prt_ctl(tab3d_1=un , clinfo1=' un - : ', mask1= tmask, ovlap=1, kdim=jpk )231 CALL prt_ctl(tab3d_1=vn , clinfo1=' vn - : ', mask1= tmask, ovlap=1, kdim=jpk )298 CALL prt_ctl(tab3d_1=un , clinfo1=' un - : ', mask1=umask, ovlap=1, kdim=jpk ) 299 CALL prt_ctl(tab3d_1=vn , clinfo1=' vn - : ', mask1=vmask, ovlap=1, kdim=jpk ) 232 300 CALL prt_ctl(tab3d_1=wn , clinfo1=' wn - : ', mask1=tmask, ovlap=1, kdim=jpk ) 233 301 CALL prt_ctl(tab3d_1=avt , clinfo1=' kz - : ', mask1=tmask, ovlap=1, kdim=jpk ) … … 239 307 ENDIF 240 308 ! 309 IF( nn_timing == 1 ) CALL timing_stop( 'dta_dyn') 310 ! 241 311 END SUBROUTINE dta_dyn 242 312 243 313 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 314 SUBROUTINE dta_dyn_init 315 !!---------------------------------------------------------------------- 316 !! *** ROUTINE dta_dyn_init *** 317 !! 318 !! ** Purpose : Initialisation of the dynamical data 319 !! ** Method : - read the data namdta_dyn namelist 320 !! 321 !! ** Action : - read parameters 322 !!---------------------------------------------------------------------- 323 INTEGER :: ierr, ierr0, ierr1, ierr2, ierr3 ! return error code 324 INTEGER :: ifpr ! dummy loop indice 325 INTEGER :: jfld ! dummy loop arguments 326 INTEGER :: inum, idv, idimv ! local integer 327 !! 328 CHARACTER(len=100) :: cn_dir ! Root directory for location of core files 329 TYPE(FLD_N), DIMENSION(jpfld) :: slf_d ! array of namelist informations on the fields to read 330 TYPE(FLD_N) :: sn_tem, sn_sal, sn_mld, sn_emp, sn_ice, sn_qsr, sn_wnd ! informations about the fields to be read 331 TYPE(FLD_N) :: sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl ! " " 332 TYPE(FLD_N) :: sn_ahu, sn_ahv, sn_ahw, sn_eiu, sn_eiv, sn_eiw ! " " 333 ! 334 NAMELIST/namdta_dyn/cn_dir, ln_dynwzv, ln_dynbbl, ln_degrad, & 335 & sn_tem, sn_sal, sn_mld, sn_emp, sn_ice, sn_qsr, sn_wnd, & 336 & sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl, & 337 & sn_ahu, sn_ahv, sn_ahw, sn_eiu, sn_eiv, sn_eiw 338 339 !!---------------------------------------------------------------------- 340 ! ! ============ 341 ! ! Namelist 342 ! ! ============ 343 ! (NB: frequency positive => hours, negative => months) 344 ! ! file ! frequency ! variable ! time intep ! clim ! 'yearly' or ! weights ! rotation ! 345 ! ! name ! (hours) ! name ! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs ! 346 sn_tem = FLD_N( 'dyna_grid_T' , 120 , 'votemper' , .true. , .true. , 'yearly' , '' , '' ) 347 sn_sal = FLD_N( 'dyna_grid_T' , 120 , 'vosaline' , .true. , .true. , 'yearly' , '' , '' ) 348 sn_mld = FLD_N( 'dyna_grid_T' , 120 , 'somixght' , .true. , .true. , 'yearly' , '' , '' ) 349 sn_emp = FLD_N( 'dyna_grid_T' , 120 , 'sowaflcd' , .true. , .true. , 'yearly' , '' , '' ) 350 sn_ice = FLD_N( 'dyna_grid_T' , 120 , 'soicecov' , .true. , .true. , 'yearly' , '' , '' ) 351 sn_qsr = FLD_N( 'dyna_grid_T' , 120 , 'soshfldo' , .true. , .true. , 'yearly' , '' , '' ) 352 sn_wnd = FLD_N( 'dyna_grid_T' , 120 , 'sowindsp' , .true. , .true. , 'yearly' , '' , '' ) 353 sn_uwd = FLD_N( 'dyna_grid_U' , 120 , 'vozocrtx' , .true. , .true. , 'yearly' , '' , '' ) 354 sn_vwd = FLD_N( 'dyna_grid_V' , 120 , 'vomecrty' , .true. , .true. , 'yearly' , '' , '' ) 355 sn_wwd = FLD_N( 'dyna_grid_W' , 120 , 'vovecrtz' , .true. , .true. , 'yearly' , '' , '' ) 356 sn_avt = FLD_N( 'dyna_grid_W' , 120 , 'votkeavt' , .true. , .true. , 'yearly' , '' , '' ) 357 sn_ubl = FLD_N( 'dyna_grid_U' , 120 , 'sobblcox' , .true. , .true. , 'yearly' , '' , '' ) 358 sn_vbl = FLD_N( 'dyna_grid_V' , 120 , 'sobblcoy' , .true. , .true. , 'yearly' , '' , '' ) 359 sn_ahu = FLD_N( 'dyna_grid_U' , 120 , 'vozoahtu' , .true. , .true. , 'yearly' , '' , '' ) 360 sn_ahv = FLD_N( 'dyna_grid_V' , 120 , 'vomeahtv' , .true. , .true. , 'yearly' , '' , '' ) 361 sn_ahw = FLD_N( 'dyna_grid_W' , 120 , 'voveahtz' , .true. , .true. , 'yearly' , '' , '' ) 362 sn_eiu = FLD_N( 'dyna_grid_U' , 120 , 'vozoaeiu' , .true. , .true. , 'yearly' , '' , '' ) 363 sn_eiv = FLD_N( 'dyna_grid_V' , 120 , 'vomeaeiv' , .true. , .true. , 'yearly' , '' , '' ) 364 sn_eiw = FLD_N( 'dyna_grid_W' , 120 , 'voveaeiw' , .true. , .true. , 'yearly' , '' , '' ) 365 ! 366 REWIND( numnam ) ! read in namlist namdta_dyn 367 READ ( numnam, namdta_dyn ) 368 ! ! store namelist information in an array 369 ! ! Control print 323 370 IF(lwp) THEN 324 371 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 372 WRITE(numout,*) 'dta_dyn : offline dynamics ' 373 WRITE(numout,*) '~~~~~~~ ' 374 WRITE(numout,*) ' Namelist namdta_dyn' 375 WRITE(numout,*) ' vertical velocity read from file (T) or computed (F) ln_dynwzv = ', ln_dynwzv 376 WRITE(numout,*) ' bbl coef read from file (T) or computed (F) ln_dynbbl = ', ln_dynbbl 377 WRITE(numout,*) ' degradation option enabled (T) or not (F) ln_degrad = ', ln_degrad 330 378 WRITE(numout,*) 331 379 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 ) 380 ! 381 IF( ln_degrad .AND. .NOT.lk_degrad ) THEN 382 CALL ctl_warn( 'dta_dyn_init: degradation option requires key_degrad activated ; force ln_degrad to false' ) 383 ln_degrad = .FALSE. 384 ENDIF 385 IF( ln_dynbbl .AND. ( .NOT.lk_trabbl .OR. lk_c1d ) ) THEN 386 CALL ctl_warn( 'dta_dyn_init: bbl option requires key_trabbl activated ; force ln_dynbbl to false' ) 387 ln_dynbbl = .FALSE. 388 ENDIF 389 390 jf_tem = 1 ; jf_sal = 2 ; jf_mld = 3 ; jf_emp = 4 ; jf_ice = 5 ; jf_qsr = 6 391 jf_wnd = 7 ; jf_uwd = 8 ; jf_vwd = 9 ; jf_wwd = 10 ; jf_avt = 11 ; jfld = 11 392 ! 393 slf_d(jf_tem) = sn_tem ; slf_d(jf_sal) = sn_sal ; slf_d(jf_mld) = sn_mld 394 slf_d(jf_emp) = sn_emp ; slf_d(jf_ice) = sn_ice ; slf_d(jf_qsr) = sn_qsr 395 slf_d(jf_wnd) = sn_wnd ; slf_d(jf_uwd) = sn_uwd ; slf_d(jf_vwd) = sn_vwd 396 slf_d(jf_wwd) = sn_wwd ; slf_d(jf_avt) = sn_avt 397 ! 398 IF( .NOT.ln_degrad ) THEN ! no degrad option 399 IF( lk_traldf_eiv .AND. ln_dynbbl ) THEN ! eiv & bbl 400 jf_ubl = 12 ; jf_vbl = 13 ; jf_eiw = 14 ; jfld = 14 401 slf_d(jf_ubl) = sn_ubl ; slf_d(jf_vbl) = sn_vbl ; slf_d(jf_eiw) = sn_eiw 402 ENDIF 403 IF( .NOT.lk_traldf_eiv .AND. ln_dynbbl ) THEN ! no eiv & bbl 404 jf_ubl = 12 ; jf_vbl = 13 ; jfld = 13 405 slf_d(jf_ubl) = sn_ubl ; slf_d(jf_vbl) = sn_vbl 406 ENDIF 407 IF( lk_traldf_eiv .AND. .NOT.ln_dynbbl ) THEN ! eiv & no bbl 408 jf_eiw = 12 ; jfld = 12 ; slf_d(jf_eiw) = sn_eiw 409 ENDIF 352 410 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 411 jf_ahu = 12 ; jf_ahv = 13 ; jf_ahw = 14 ; jfld = 14 412 slf_d(jf_ahu) = sn_ahu ; slf_d(jf_ahv) = sn_ahv ; slf_d(jf_ahw) = sn_ahw 413 IF( lk_traldf_eiv .AND. ln_dynbbl ) THEN ! eiv & bbl 414 jf_ubl = 15 ; jf_vbl = 16 415 slf_d(jf_ubl) = sn_ubl ; slf_d(jf_vbl) = sn_vbl 416 jf_eiu = 17 ; jf_eiv = 18 ; jf_eiw = 19 ; jfld = 19 417 slf_d(jf_eiu) = sn_eiu ; slf_d(jf_eiv) = sn_eiv ; slf_d(jf_eiw) = sn_eiw 418 ENDIF 419 IF( .NOT.lk_traldf_eiv .AND. ln_dynbbl ) THEN ! no eiv & bbl 420 jf_ubl = 15 ; jf_vbl = 16 ; jfld = 16 421 slf_d(jf_ubl) = sn_ubl ; slf_d(jf_vbl) = sn_vbl 422 ENDIF 423 IF( lk_traldf_eiv .AND. .NOT.ln_dynbbl ) THEN ! eiv & no bbl 424 jf_eiu = 15 ; jf_eiv = 16 ; jf_eiw = 17 ; jfld = 17 425 slf_d(jf_eiu) = sn_eiu ; slf_d(jf_eiv) = sn_eiv ; slf_d(jf_eiw) = sn_eiw 426 ENDIF 427 ENDIF 428 429 ALLOCATE( sf_dyn(jfld), STAT=ierr ) ! set sf structure 430 IF( ierr > 0 ) THEN 431 CALL ctl_stop( 'dta_dyn: unable to allocate sf structure' ) ; RETURN 432 ENDIF 433 ! Open file for each variable to get his number of dimension 434 DO ifpr = 1, jfld 435 CALL iom_open( slf_d(ifpr)%clname, inum ) 436 idv = iom_varid( inum , slf_d(ifpr)%clvar ) ! id of the variable sdjf%clvar 437 idimv = iom_file ( inum )%ndims(idv) ! number of dimension for variable sdjf%clvar 438 IF( inum /= 0 ) CALL iom_close( inum ) ! close file if already open 439 IF( idimv == 3 ) THEN ! 2D variable 440 ALLOCATE( sf_dyn(ifpr)%fnow(jpi,jpj,1) , STAT=ierr0 ) 441 IF( slf_d(ifpr)%ln_tint ) ALLOCATE( sf_dyn(ifpr)%fdta(jpi,jpj,1,2) , STAT=ierr1 ) 442 ELSE ! 3D variable 443 ALLOCATE( sf_dyn(ifpr)%fnow(jpi,jpj,jpk) , STAT=ierr0 ) 444 IF( slf_d(ifpr)%ln_tint ) ALLOCATE( sf_dyn(ifpr)%fdta(jpi,jpj,jpk,2), STAT=ierr1 ) 445 ENDIF 446 IF( ierr0 + ierr1 > 0 ) THEN 447 CALL ctl_stop( 'dta_dyn_init : unable to allocate sf_dyn array structure' ) ; RETURN 448 ENDIF 449 END DO 450 ! ! fill sf with slf_i and control print 451 CALL fld_fill( sf_dyn, slf_d, cn_dir, 'dta_dyn_init', 'Data in file', 'namdta_dyn' ) 452 ! 453 IF( lk_ldfslp .AND. .NOT.lk_c1d ) THEN ! slopes 454 IF( sf_dyn(jf_tem)%ln_tint ) THEN ! time interpolation 455 ALLOCATE( uslpdta (jpi,jpj,jpk,2), vslpdta (jpi,jpj,jpk,2), & 456 & wslpidta(jpi,jpj,jpk,2), wslpjdta(jpi,jpj,jpk,2), STAT=ierr2 ) 457 ELSE 458 ALLOCATE( uslpnow (jpi,jpj,jpk) , vslpnow (jpi,jpj,jpk) , & 459 & wslpinow(jpi,jpj,jpk) , wslpjnow(jpi,jpj,jpk) , STAT=ierr2 ) 460 ENDIF 461 IF( ierr2 > 0 ) THEN 462 CALL ctl_stop( 'dta_dyn_init : unable to allocate slope arrays' ) ; RETURN 463 ENDIF 464 ENDIF 465 IF( ln_dynwzv ) THEN ! slopes 466 IF( sf_dyn(jf_uwd)%ln_tint ) THEN ! time interpolation 467 ALLOCATE( wdta(jpi,jpj,jpk,2), STAT=ierr3 ) 468 ELSE 469 ALLOCATE( wnow(jpi,jpj,jpk) , STAT=ierr3 ) 470 ENDIF 471 IF( ierr3 > 0 ) THEN 472 CALL ctl_stop( 'dta_dyn_init : unable to allocate wdta arrays' ) ; RETURN 473 ENDIF 474 ENDIF 516 475 ! 517 476 CALL dta_dyn( nit000 ) … … 519 478 END SUBROUTINE dta_dyn_init 520 479 521 522 SUBROUTINE wzv( pu, pv, pw ) 480 SUBROUTINE dta_dyn_wzv( pu, pv, pw ) 523 481 !!---------------------------------------------------------------------- 524 482 !! *** ROUTINE wzv *** … … 534 492 !! The boundary conditions are w=0 at the bottom (no flux). 535 493 !!---------------------------------------------------------------------- 494 USE oce, ONLY: zhdiv => hdivn 495 ! 536 496 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pu, pv !: horizontal velocities 537 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out) :: pw !: vertic lavelocity497 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out) :: pw !: vertical velocity 538 498 !! 539 499 INTEGER :: ji, jj, jk 540 500 REAL(wp) :: zu, zu1, zv, zv1, zet 541 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zhdiv !: horizontal divergence542 501 !!---------------------------------------------------------------------- 543 502 ! 544 503 ! Computation of vertical velocity using horizontal divergence 545 zhdiv(:,:,:) = 0. 504 zhdiv(:,:,:) = 0._wp 546 505 DO jk = 1, jpkm1 547 506 DO jj = 2, jpjm1 … … 564 523 END DO 565 524 ! 566 END SUBROUTINE wzv567 568 569 SUBROUTINE dta_eiv( kt )570 !! ----------------------------------------------------------------------571 !! *** ROUTINE dta_eiv ***572 !! 573 !! ** Purpose : Compute the eddy induced velocity coefficient from the574 !! growth rate of baroclinic instability.575 !!576 !! ** Method : Specific to the offline model. Computes the horizontal577 !! values from the vertical value578 !!----------------------------------------------------------------------579 INTEGER, INTENT( in ) :: kt ! ocean time-step inedx580 !!581 INTEGER :: ji, jj ! dummy loop indices582 !!---------------------------------------------------------------------- 583 !584 IF( kt == nit000 ) THEN585 IF(lwp) WRITE(numout,*)586 IF(lwp) WRITE(numout,*) 'dta_eiv : eddy induced velocity coefficients'587 IF(lwp) WRITE(numout,*) '~~~~~~~'588 ENDIF589 !590 #if defined key_ldfeiv 591 ! Average the diffusive coefficient at u- v- points592 DO jj = 2, jpjm1593 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 DO597 END DO598 CALL lbc_lnk( aeiu, 'U', 1. ) ; CALL lbc_lnk( aeiv, 'V', 1. ) ! lateral boundary condition525 END SUBROUTINE dta_dyn_wzv 526 527 SUBROUTINE dta_dyn_slp( kt, pts, puslp, pvslp, pwslpi, pwslpj ) 528 !!--------------------------------------------------------------------- 529 !! *** ROUTINE dta_dyn_slp *** 530 !! 531 !! ** Purpose : Computation of slope 532 !! 533 !!--------------------------------------------------------------------- 534 INTEGER , INTENT(in ) :: kt ! time step 535 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! temperature/salinity 536 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(out) :: puslp ! zonal isopycnal slopes 537 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(out) :: pvslp ! meridional isopycnal slopes 538 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(out) :: pwslpi ! zonal diapycnal slopes 539 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(out) :: pwslpj ! meridional diapycnal slopes 540 !!--------------------------------------------------------------------- 541 #if defined key_ldfslp && ! defined key_c1d 542 CALL eos( pts, rhd, rhop ) ! Time-filtered in situ density 543 CALL bn2( pts, rn2 ) ! before Brunt-Vaisala frequency 544 IF( ln_zps ) & 545 & CALL zps_hde( kt, jpts, pts, gtsu, gtsv, rhd, gru, grv ) ! Partial steps: before Horizontal DErivative 546 ! ! of t, s, rd at the bottom ocean level 547 CALL zdf_mxl( kt ) ! mixed layer depth 548 CALL ldf_slp( kt, rhd, rn2 ) ! slopes 549 puslp (:,:,:) = uslp (:,:,:) 550 pvslp (:,:,:) = vslp (:,:,:) 551 pwslpi(:,:,:) = wslpi(:,:,:) 552 pwslpj(:,:,:) = wslpj(:,:,:) 553 #else 554 puslp (:,:,:) = 0. ! to avoid warning when compiling 555 pvslp (:,:,:) = 0. 556 pwslpi(:,:,:) = 0. 557 pwslpj(:,:,:) = 0. 599 558 #endif 600 559 ! 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 560 END SUBROUTINE dta_dyn_slp 796 561 !!====================================================================== 797 562 END MODULE dtadyn -
trunk/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90
r2758 r3294 43 43 USE mod_ioclient 44 44 #endif 45 USE prtctl ! Print control (prt_ctl_init routine) 45 USE prtctl ! Print control (prt_ctl_init routine) 46 USE timing ! Timing 46 47 47 48 IMPLICIT NONE … … 110 111 ENDIF 111 112 ! 113 IF( nn_timing == 1 ) CALL timing_finalize 114 ! 112 115 CALL nemo_closefile 113 116 ! … … 128 131 !! 129 132 NAMELIST/namctl/ ln_ctl , nn_print, nn_ictls, nn_ictle, & 130 & nn_isplt, nn_jsplt, nn_jctls, nn_jctle, nn_bench 133 & nn_isplt, nn_jsplt, nn_jctls, nn_jctle, & 134 & nn_bench, nn_timing 131 135 !!---------------------------------------------------------------------- 132 136 ! … … 208 212 ENDIF 209 213 ! 214 IF( nn_timing == 1 ) CALL timing_init 215 ! 216 210 217 ! ! General initialization 218 IF( nn_timing == 1 ) CALL timing_start( 'nemo_init') 219 ! 211 220 CALL phy_cst ! Physical constants 212 221 CALL eos_init ! Equation of state … … 215 224 CALL istate_init ! ocean initial state (Dynamics and tracers) 216 225 226 IF( ln_nnogather ) CALL nemo_northcomms ! Initialise the northfold neighbour lists (must be done after the masks are defined) 217 227 218 228 IF( ln_ctl ) CALL prt_ctl_init ! Print control … … 236 246 237 247 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA 248 ! 249 IF( nn_timing == 1 ) CALL timing_stop( 'nemo_init') 238 250 ! 239 251 END SUBROUTINE nemo_init … … 359 371 USE ldftra_oce, ONLY: ldftra_oce_alloc 360 372 USE trc_oce, ONLY: trc_oce_alloc 361 USE wrk_nemo, ONLY: wrk_alloc362 373 ! 363 374 INTEGER :: ierr … … 372 383 ierr = ierr + lib_mpp_alloc (numout) ! mpp exchanges 373 384 ierr = ierr + trc_oce_alloc () ! shared TRC / TRA arrays 374 ierr = ierr + wrk_alloc(numout, lwp)375 385 ! 376 386 IF( lk_mpp ) CALL mpp_sum( ierr ) … … 493 503 END SUBROUTINE factorise 494 504 505 #if defined key_mpp_mpi 506 SUBROUTINE nemo_northcomms 507 !!====================================================================== 508 !! *** ROUTINE nemo_northcomms *** 509 !! nemo_northcomms : Setup for north fold exchanges with explicit peer to peer messaging 510 !!===================================================================== 511 !!---------------------------------------------------------------------- 512 !! 513 !! ** Purpose : Initialization of the northern neighbours lists. 514 !!---------------------------------------------------------------------- 515 !! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) 516 !!---------------------------------------------------------------------- 517 518 INTEGER :: ji, jj, jk, ij, jtyp ! dummy loop indices 519 INTEGER :: ijpj ! number of rows involved in north-fold exchange 520 INTEGER :: northcomms_alloc ! allocate return status 521 REAL(wp), ALLOCATABLE, DIMENSION ( :,: ) :: znnbrs ! workspace 522 LOGICAL, ALLOCATABLE, DIMENSION ( : ) :: lrankset ! workspace 523 524 IF(lwp) WRITE(numout,*) 525 IF(lwp) WRITE(numout,*) 'nemo_northcomms : Initialization of the northern neighbours lists' 526 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 527 528 !!---------------------------------------------------------------------- 529 ALLOCATE( znnbrs(jpi,jpj), stat = northcomms_alloc ) 530 ALLOCATE( lrankset(jpnij), stat = northcomms_alloc ) 531 IF( northcomms_alloc /= 0 ) THEN 532 WRITE(numout,cform_war) 533 WRITE(numout,*) 'northcomms_alloc : failed to allocate arrays' 534 CALL ctl_stop( 'STOP', 'nemo_northcomms : unable to allocate temporary arrays' ) 535 ENDIF 536 nsndto = 0 537 isendto = -1 538 ijpj = 4 539 ! 540 ! This routine has been called because ln_nnogather has been set true ( nammpp ) 541 ! However, these first few exchanges have to use the mpi_allgather method to 542 ! establish the neighbour lists to use in subsequent peer to peer exchanges. 543 ! Consequently, set l_north_nogather to be false here and set it true only after 544 ! the lists have been established. 545 ! 546 l_north_nogather = .FALSE. 547 ! 548 ! Exchange and store ranks on northern rows 549 550 DO jtyp = 1,4 551 552 lrankset = .FALSE. 553 znnbrs = narea 554 SELECT CASE (jtyp) 555 CASE(1) 556 CALL lbc_lnk( znnbrs, 'T', 1. ) ! Type 1: T,W-points 557 CASE(2) 558 CALL lbc_lnk( znnbrs, 'U', 1. ) ! Type 2: U-point 559 CASE(3) 560 CALL lbc_lnk( znnbrs, 'V', 1. ) ! Type 3: V-point 561 CASE(4) 562 CALL lbc_lnk( znnbrs, 'F', 1. ) ! Type 4: F-point 563 END SELECT 564 565 IF ( njmppt(narea) .EQ. MAXVAL( njmppt ) ) THEN 566 DO jj = nlcj-ijpj+1, nlcj 567 ij = jj - nlcj + ijpj 568 DO ji = 1,jpi 569 IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) & 570 & lrankset(INT(znnbrs(ji,jj))) = .true. 571 END DO 572 END DO 573 574 DO jj = 1,jpnij 575 IF ( lrankset(jj) ) THEN 576 nsndto(jtyp) = nsndto(jtyp) + 1 577 IF ( nsndto(jtyp) .GT. jpmaxngh ) THEN 578 CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', & 579 & ' jpmaxngh will need to be increased ') 580 ENDIF 581 isendto(nsndto(jtyp),jtyp) = jj-1 ! narea converted to MPI rank 582 ENDIF 583 END DO 584 ENDIF 585 586 END DO 587 588 ! 589 ! Type 5: I-point 590 ! 591 ! ICE point exchanges may involve some averaging. The neighbours list is 592 ! built up using two exchanges to ensure that the whole stencil is covered. 593 ! lrankset should not be reset between these 'J' and 'K' point exchanges 594 595 jtyp = 5 596 lrankset = .FALSE. 597 znnbrs = narea 598 CALL lbc_lnk( znnbrs, 'J', 1. ) ! first ice U-V point 599 600 IF ( njmppt(narea) .EQ. MAXVAL( njmppt ) ) THEN 601 DO jj = nlcj-ijpj+1, nlcj 602 ij = jj - nlcj + ijpj 603 DO ji = 1,jpi 604 IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) & 605 & lrankset(INT(znnbrs(ji,jj))) = .true. 606 END DO 607 END DO 608 ENDIF 609 610 znnbrs = narea 611 CALL lbc_lnk( znnbrs, 'K', 1. ) ! second ice U-V point 612 613 IF ( njmppt(narea) .EQ. MAXVAL( njmppt )) THEN 614 DO jj = nlcj-ijpj+1, nlcj 615 ij = jj - nlcj + ijpj 616 DO ji = 1,jpi 617 IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) & 618 & lrankset( INT(znnbrs(ji,jj))) = .true. 619 END DO 620 END DO 621 622 DO jj = 1,jpnij 623 IF ( lrankset(jj) ) THEN 624 nsndto(jtyp) = nsndto(jtyp) + 1 625 IF ( nsndto(jtyp) .GT. jpmaxngh ) THEN 626 CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', & 627 & ' jpmaxngh will need to be increased ') 628 ENDIF 629 isendto(nsndto(jtyp),jtyp) = jj-1 ! narea converted to MPI rank 630 ENDIF 631 END DO 632 ! 633 ! For northern row areas, set l_north_nogather so that all subsequent exchanges 634 ! can use peer to peer communications at the north fold 635 ! 636 l_north_nogather = .TRUE. 637 ! 638 ENDIF 639 DEALLOCATE( znnbrs ) 640 DEALLOCATE( lrankset ) 641 642 END SUBROUTINE nemo_northcomms 643 #else 644 SUBROUTINE nemo_northcomms ! Dummy routine 645 WRITE(*,*) 'nemo_northcomms: You should not have seen this print! error?' 646 END SUBROUTINE nemo_northcomms 647 #endif 495 648 !!====================================================================== 496 649 END MODULE nemogcm
Note: See TracChangeset
for help on using the changeset viewer.
