Changeset 12866
- Timestamp:
- 2020-05-05T08:18:05+02:00 (3 years ago)
- Location:
- NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo
- Files:
-
- 13 edited
-
cfgs/ORCA2_ICE_PISCES/EXPREF/namelist_cfg (modified) (2 diffs)
-
cfgs/SHARED/namelist_ref (modified) (1 diff)
-
src/OCE/BDY/bdyini.F90 (modified) (1 diff)
-
src/OCE/DOM/domain.F90 (modified) (1 diff)
-
src/OCE/IOM/iom.F90 (modified) (1 diff)
-
src/OCE/SBC/fldread.F90 (modified) (31 diffs)
-
src/OCE/TRA/traadv_fct.F90 (modified) (1 diff)
-
src/OCE/USR/usrdef_fmask.F90 (modified) (2 diffs)
-
src/OCE/USR/usrdef_hgr.F90 (modified) (3 diffs)
-
src/OCE/USR/usrdef_nam.F90 (modified) (2 diffs)
-
src/OCE/USR/usrdef_zgr.F90 (modified) (1 diff)
-
src/OFF/dtadyn.F90 (modified) (7 diffs)
-
tests/BENCH/MY_SRC/usrdef_zgr.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/cfgs/ORCA2_ICE_PISCES/EXPREF/namelist_cfg
r12501 r12866 109 109 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! 110 110 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! ! pairing ! filename ! 111 sn_wndi = 'u_10.15JUNE2009_fill' , 6. , 'U_10_MOD', .false. , .true. , 'yearly' , 'weights_core _orca2_bicubic_noc.nc' , 'Uwnd' , ''112 sn_wndj = 'v_10.15JUNE2009_fill' , 6. , 'V_10_MOD', .false. , .true. , 'yearly' , 'weights_core _orca2_bicubic_noc.nc' , 'Vwnd' , ''113 sn_qsr = 'ncar_rad.15JUNE2009_fill' , 24. , 'SWDN_MOD', .false. , .true. , 'yearly' , 'weights_core _orca2_bilinear_noc.nc' , '' , ''114 sn_qlw = 'ncar_rad.15JUNE2009_fill' , 24. , 'LWDN_MOD', .false. , .true. , 'yearly' , 'weights_core _orca2_bilinear_noc.nc' , '' , ''115 sn_tair = 't_10.15JUNE2009_fill' , 6. , 'T_10_MOD', .false. , .true. , 'yearly' , 'weights_core _orca2_bilinear_noc.nc' , '' , ''116 sn_humi = 'q_10.15JUNE2009_fill' , 6. , 'Q_10_MOD', .false. , .true. , 'yearly' , 'weights_core _orca2_bilinear_noc.nc' , '' , ''117 sn_prec = 'ncar_precip.15JUNE2009_fill', -1. , 'PRC_MOD1', .false. , .true. , 'yearly' , 'weights_core _orca2_bilinear_noc.nc' , '' , ''118 sn_snow = 'ncar_precip.15JUNE2009_fill', -1. , 'SNOW' , .false. , .true. , 'yearly' , 'weights_core _orca2_bilinear_noc.nc' , '' , ''119 sn_slp = 'slp.15JUNE2009_fill' , 6. , 'SLP' , .false. , .true. , 'yearly' , 'weights_core _orca2_bilinear_noc.nc' , '' , ''111 sn_wndi = 'u_10.15JUNE2009_fill' , 6. , 'U_10_MOD', .false. , .true. , 'yearly' , 'weights_core2_orca2_bicub' , 'Uwnd' , '' 112 sn_wndj = 'v_10.15JUNE2009_fill' , 6. , 'V_10_MOD', .false. , .true. , 'yearly' , 'weights_core2_orca2_bicub' , 'Vwnd' , '' 113 sn_qsr = 'ncar_rad.15JUNE2009_fill' , 24. , 'SWDN_MOD', .false. , .true. , 'yearly' , 'weights_core2_orca2_bilin' , '' , '' 114 sn_qlw = 'ncar_rad.15JUNE2009_fill' , 24. , 'LWDN_MOD', .false. , .true. , 'yearly' , 'weights_core2_orca2_bilin' , '' , '' 115 sn_tair = 't_10.15JUNE2009_fill' , 6. , 'T_10_MOD', .false. , .true. , 'yearly' , 'weights_core2_orca2_bilin' , '' , '' 116 sn_humi = 'q_10.15JUNE2009_fill' , 6. , 'Q_10_MOD', .false. , .true. , 'yearly' , 'weights_core2_orca2_bilin' , '' , '' 117 sn_prec = 'ncar_precip.15JUNE2009_fill', -1. , 'PRC_MOD1', .false. , .true. , 'yearly' , 'weights_core2_orca2_bilin' , '' , '' 118 sn_snow = 'ncar_precip.15JUNE2009_fill', -1. , 'SNOW' , .false. , .true. , 'yearly' , 'weights_core2_orca2_bilin' , '' , '' 119 sn_slp = 'slp.15JUNE2009_fill' , 6. , 'SLP' , .false. , .true. , 'yearly' , 'weights_core2_orca2_bilin' , '' , '' 120 120 / 121 121 !----------------------------------------------------------------------- … … 386 386 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! 387 387 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! ! pairing ! filename ! 388 sn_mpb = ' mixing_power_bot' , -12 , 'field' , .false. , .true. , 'yearly' , '' , '' , ''389 sn_mpp = ' mixing_power_pyc' , -12 , 'field' , .false. , .true. , 'yearly' , '' , '' , ''390 sn_mpc = ' mixing_power_cri' , -12 , 'field' , .false. , .true. , 'yearly' , '' , '' , ''391 sn_dsb = ' decay_scale_bot' , -12 , 'field', .false. , .true. , 'yearly' , '' , '' , ''392 sn_dsc = ' decay_scale_cri' , -12 , 'field', .false. , .true. , 'yearly' , '' , '' , ''388 sn_mpb = 'int_wave_mix' , -12. , 'mixing_power_bot' , .false. , .true. , 'yearly' , '' , '' , '' 389 sn_mpp = 'int_wave_mix' , -12. , 'mixing_power_pyc' , .false. , .true. , 'yearly' , '' , '' , '' 390 sn_mpc = 'int_wave_mix' , -12. , 'mixing_power_cri' , .false. , .true. , 'yearly' , '' , '' , '' 391 sn_dsb = 'int_wave_mix' , -12. , 'decay_scale_bot' , .false. , .true. , 'yearly' , '' , '' , '' 392 sn_dsc = 'int_wave_mix' , -12. , 'decay_scale_cri' , .false. , .true. , 'yearly' , '' , '' , '' 393 393 / 394 394 !!====================================================================== -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/cfgs/SHARED/namelist_ref
r12530 r12866 1197 1197 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! 1198 1198 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! ! pairing ! filename ! 1199 sn_mpb = 'NOT USED' , -12 1200 sn_mpp = 'NOT USED' , -12 1201 sn_mpc = 'NOT USED' , -12 1202 sn_dsb = 'NOT USED' , -12 1203 sn_dsc = 'NOT USED' , -12 1199 sn_mpb = 'NOT USED' , -12. , 'mixing_power_bot' , .false. , .true. , 'yearly' , '' , '' , '' 1200 sn_mpp = 'NOT USED' , -12. , 'mixing_power_pyc' , .false. , .true. , 'yearly' , '' , '' , '' 1201 sn_mpc = 'NOT USED' , -12. , 'mixing_power_cri' , .false. , .true. , 'yearly' , '' , '' , '' 1202 sn_dsb = 'NOT USED' , -12. , 'decay_scale_bot' , .false. , .true. , 'yearly' , '' , '' , '' 1203 sn_dsc = 'NOT USED' , -12. , 'decay_scale_cri' , .false. , .true. , 'yearly' , '' , '' , '' 1204 1204 / 1205 1205 !!====================================================================== -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/BDY/bdyini.F90
r12377 r12866 410 410 CALL iom_get( inum, jpdom_unknown, 'nbi'//cgrid(igrd), zz_read(1:nblendta(igrd,ib_bdy),:) ) 411 411 DO ii = 1,nblendta(igrd,ib_bdy) 412 nbidta(ii,igrd,ib_bdy) = NINT( zz_read(ii,1) ) 412 nbidta(ii,igrd,ib_bdy) = NINT( zz_read(ii,1) ) + nn_hls 413 413 END DO 414 414 CALL iom_get( inum, jpdom_unknown, 'nbj'//cgrid(igrd), zz_read(1:nblendta(igrd,ib_bdy),:) ) 415 415 DO ii = 1,nblendta(igrd,ib_bdy) 416 nbjdta(ii,igrd,ib_bdy) = NINT( zz_read(ii,1) ) 416 nbjdta(ii,igrd,ib_bdy) = NINT( zz_read(ii,1) ) + nn_hls 417 417 END DO 418 418 CALL iom_get( inum, jpdom_unknown, 'nbr'//cgrid(igrd), zz_read(1:nblendta(igrd,ib_bdy),:) ) -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DOM/domain.F90
r12489 r12866 565 565 IF(lwp) THEN 566 566 WRITE(numout,*) ' cn_cfg = ', TRIM(cd_cfg), ' nn_cfg = ', kk_cfg 567 WRITE(numout,*) ' jpiglo = ', kpi568 WRITE(numout,*) ' jpjglo = ', kpj567 WRITE(numout,*) ' Ni0glo = ', kpi 568 WRITE(numout,*) ' Nj0glo = ', kpj 569 569 WRITE(numout,*) ' jpkglo = ', kpk 570 570 WRITE(numout,*) ' type of global domain lateral boundary jperio = ', kperio -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/IOM/iom.F90
r12815 r12866 1226 1226 IF( PRESENT(psgn ) ) zsgn = psgn 1227 1227 !--- overlap areas and extra hallows (mpp) 1228 IF( PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN1228 IF( PRESENT(pv_r2d) .AND. idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN 1229 1229 CALL lbc_lnk( 'iom', pv_r2d, cl_type, zsgn, kfillmode = kfill ) 1230 ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN1230 ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN 1231 1231 CALL lbc_lnk( 'iom', pv_r3d, cl_type, zsgn, kfillmode = kfill ) 1232 1232 ENDIF -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/SBC/fldread.F90
r12738 r12866 71 71 CHARACTER(len = 8) :: cltype ! type of data file 'daily', 'monthly' or yearly' 72 72 INTEGER :: num ! iom id of the jpfld files to be read 73 INTEGER , DIMENSION(2) :: nrec_b ! before record (1: index, 2: second since Jan. 1st 00h of nit000 year) 74 INTEGER , DIMENSION(2) :: nrec_a ! after record (1: index, 2: second since Jan. 1st 00h of nit000 year) 73 INTEGER , DIMENSION(2,2) :: nrec ! before/after record (1: index, 2: second since Jan. 1st 00h of yr nit000) 74 INTEGER :: nbb ! index of before values 75 INTEGER :: naa ! index of after values 75 76 INTEGER , ALLOCATABLE, DIMENSION(: ) :: nrecsec ! 76 77 REAL(wp), ALLOCATABLE, DIMENSION(:,:,: ) :: fnow ! input fields interpolated to now time step … … 156 157 INTEGER :: jf ! dummy indices 157 158 INTEGER :: isecsbc ! number of seconds between Jan. 1st 00h of nit000 year and the middle of sbc time step 159 INTEGER :: ibb, iaa ! shorter name for sd(jf)%nbb and sd(jf)%naa 158 160 LOGICAL :: ll_firstcall ! true if this is the first call to fld_read for this set of fields 159 161 REAL(wp) :: zt_offset ! local time offset variable … … 203 205 IF( TRIM(sd(jf)%clrootname) == 'NOT USED' ) CYCLE 204 206 ! 207 ibb = sd(jf)%nbb ; iaa = sd(jf)%naa 208 ! 205 209 IF( sd(jf)%ln_tint ) THEN ! temporal interpolation 206 210 IF(lwp .AND. kt - nit000 <= 100 ) THEN … … 208 212 & "', records b/a: ', i6.4, '/', i6.4, ' (days ', f9.4,'/', f9.4, ')')" 209 213 WRITE(numout, clfmt) TRIM( sd(jf)%clvar ), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday, & 210 & sd(jf)%nrec _b(1), sd(jf)%nrec_a(1), REAL(sd(jf)%nrec_b(2),wp)/rday, REAL(sd(jf)%nrec_a(2),wp)/rday214 & sd(jf)%nrec(1,ibb), sd(jf)%nrec(1,iaa), REAL(sd(jf)%nrec(2,ibb),wp)/rday, REAL(sd(jf)%nrec(2,iaa),wp)/rday 211 215 WRITE(numout, *) ' zt_offset is : ',zt_offset 212 216 ENDIF 213 217 ! temporal interpolation weights 214 ztinta = REAL( isecsbc - sd(jf)%nrec _b(2), wp ) / REAL( sd(jf)%nrec_a(2) - sd(jf)%nrec_b(2), wp )218 ztinta = REAL( isecsbc - sd(jf)%nrec(2,ibb), wp ) / REAL( sd(jf)%nrec(2,iaa) - sd(jf)%nrec(2,ibb), wp ) 215 219 ztintb = 1. - ztinta 216 sd(jf)%fnow(:,:,:) = ztintb * sd(jf)%fdta(:,:,:, 1) + ztinta * sd(jf)%fdta(:,:,:,2)220 sd(jf)%fnow(:,:,:) = ztintb * sd(jf)%fdta(:,:,:,ibb) + ztinta * sd(jf)%fdta(:,:,:,iaa) 217 221 ELSE ! nothing to do... 218 222 IF(lwp .AND. kt - nit000 <= 100 ) THEN … … 220 224 & "', record: ', i6.4, ' (days ', f9.4, ' <-> ', f9.4, ')')" 221 225 WRITE(numout, clfmt) TRIM(sd(jf)%clvar), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday, & 222 & sd(jf)%nrec _a(1), REAL(sd(jf)%nrec_b(2),wp)/rday, REAL(sd(jf)%nrec_a(2),wp)/rday226 & sd(jf)%nrec(1,iaa), REAL(sd(jf)%nrec(2,ibb),wp)/rday, REAL(sd(jf)%nrec(2,iaa),wp)/rday 223 227 ENDIF 224 228 ENDIF … … 250 254 ! 251 255 CALL fld_clopn( sdjf ) 252 sdjf%nrec _a(:) = (/ 1, nflag /) ! default definition to force flp_update to read the file.256 sdjf%nrec(:,sdjf%naa) = (/ 1, nflag /) ! default definition to force flp_update to read the file. 253 257 ! 254 258 END SUBROUTINE fld_init … … 261 265 !! ** Purpose : Compute 262 266 !! if sdjf%ln_tint = .TRUE. 263 !! nrec _a: record number and its time (nrec_b is obtained from nrec_awhen swapping)267 !! nrec(:,iaa): record number and its time (nrec(:,ibb) is obtained from nrec(:,iaa) when swapping) 264 268 !! if sdjf%ln_tint = .FALSE. 265 !! nrec _a(1): record number266 !! nrec _b(2) and nrec_a(2): time of the beginning and end of the record269 !! nrec(1,iaa): record number 270 !! nrec(2,ibb) and nrec(2,iaa): time of the beginning and end of the record 267 271 !!---------------------------------------------------------------------- 268 272 INTEGER , INTENT(in ) :: ksecsbc ! … … 270 274 INTEGER , OPTIONAL, INTENT(in ) :: Kmm ! ocean time level index 271 275 ! 272 INTEGER :: ja ! end of this record (in seconds) 273 !!---------------------------------------------------------------------- 274 ! 275 IF( ksecsbc > sdjf%nrec_a(2) ) THEN ! --> we need to update after data 276 INTEGER :: ja ! end of this record (in seconds) 277 INTEGER :: ibb, iaa ! shorter name for sdjf%nbb and sdjf%naa 278 !!---------------------------------------------------------------------- 279 ibb = sdjf%nbb ; iaa = sdjf%naa 280 ! 281 IF( ksecsbc > sdjf%nrec(2,iaa) ) THEN ! --> we need to update after data 276 282 277 ! find where is the new after record... (it is not necessary sdjf%nrec _a(1)+1 )278 ja = sdjf%nrec _a(1)283 ! find where is the new after record... (it is not necessary sdjf%nrec(1,iaa)+1 ) 284 ja = sdjf%nrec(1,iaa) 279 285 DO WHILE ( ksecsbc >= sdjf%nrecsec(ja) .AND. ja < sdjf%nreclast ) ! Warning: make sure ja <= sdjf%nreclast in this test 280 286 ja = ja + 1 … … 283 289 284 290 ! if ln_tint and if the new after is not ja+1, we need also to update after data before the swap 285 ! so, after the swap, sdjf%nrec _b(2) will still be the closest value located just before ksecsbc286 IF( sdjf%ln_tint .AND. ( ja > sdjf%nrec _a(1) + 1 .OR. sdjf%nrec_a(2) == nflag ) ) THEN287 sdjf%nrec _a(:) = (/ ja-1, sdjf%nrecsec(ja-1) /) ! update nrec_awith before information288 CALL fld_get( sdjf, Kmm ) ! read after data that will be used as before data291 ! so, after the swap, sdjf%nrec(2,ibb) will still be the closest value located just before ksecsbc 292 IF( sdjf%ln_tint .AND. ( ja > sdjf%nrec(1,iaa) + 1 .OR. sdjf%nrec(2,iaa) == nflag ) ) THEN 293 sdjf%nrec(:,iaa) = (/ ja-1, sdjf%nrecsec(ja-1) /) ! update nrec(:,iaa) with before information 294 CALL fld_get( sdjf, Kmm ) ! read after data that will be used as before data 289 295 ENDIF 290 296 … … 309 315 ! if ln_tint and if after is not the first record, we must (potentially again) update after data before the swap 310 316 IF( sdjf%ln_tint .AND. ja > 1 ) THEN 311 IF( sdjf%nrecsec(0) /= nflag ) THEN ! no trick used: after file is not the current file312 sdjf%nrec _a(:) = (/ ja-1, sdjf%nrecsec(ja-1) /) ! update nrec_awith before information313 CALL fld_get( sdjf, Kmm ) ! read after data that will be used as before data317 IF( sdjf%nrecsec(0) /= nflag ) THEN ! no trick used: after file is not the current file 318 sdjf%nrec(:,iaa) = (/ ja-1, sdjf%nrecsec(ja-1) /) ! update nrec(:,iaa) with before information 319 CALL fld_get( sdjf, Kmm ) ! read after data that will be used as before data 314 320 ENDIF 315 321 ENDIF … … 317 323 ENDIF 318 324 319 IF( sdjf%ln_tint ) THEN 320 ! Swap data 321 sdjf%nrec_b(:) = sdjf%nrec_a(:) ! swap before record informations 322 sdjf%rotn(1) = sdjf%rotn(2) ! swap before rotate informations 323 sdjf%fdta(:,:,:,1) = sdjf%fdta(:,:,:,2) ! swap before record field 324 ELSE 325 sdjf%nrec_b(:) = (/ ja-1, sdjf%nrecsec(ja-1) /) ! only for print 325 IF( sdjf%ln_tint ) THEN ! Swap data 326 sdjf%nbb = sdjf%naa ! swap indices 327 sdjf%naa = 3 - sdjf%naa ! = 2(1) if naa == 1(2) 328 ELSE ! No swap 329 sdjf%nrec(:,ibb) = (/ ja-1, sdjf%nrecsec(ja-1) /) ! only for print 326 330 ENDIF 327 331 328 332 ! read new after data 329 sdjf%nrec _a(:) = (/ ja, sdjf%nrecsec(ja) /) ! update nrec_aas it is used by fld_get330 CALL fld_get( sdjf, Kmm ) ! read after data (with nrec_ainformations)333 sdjf%nrec(:,sdjf%naa) = (/ ja, sdjf%nrecsec(ja) /) ! update nrec(:,naa) as it is used by fld_get 334 CALL fld_get( sdjf, Kmm ) ! read after data (with nrec(:,naa) informations) 331 335 332 336 ENDIF … … 345 349 ! 346 350 INTEGER :: ipk ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) 351 INTEGER :: iaa ! shorter name for sdjf%naa 347 352 INTEGER :: iw ! index into wgts array 348 353 INTEGER :: ipdom ! index of the domain … … 353 358 ! 354 359 ipk = SIZE( sdjf%fnow, 3 ) 360 iaa = sdjf%naa 355 361 ! 356 362 IF( ASSOCIATED(sdjf%imap) ) THEN 357 IF( sdjf%ln_tint ) THEN ; CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:, 2), sdjf%nrec_a(1), &363 IF( sdjf%ln_tint ) THEN ; CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,iaa), sdjf%nrec(1,iaa), & 358 364 & sdjf%imap, sdjf%igrd, sdjf%ibdy, sdjf%ltotvel, sdjf%lzint, Kmm ) 359 ELSE ; CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,: ), sdjf%nrec_a(1), &365 ELSE ; CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,: ), sdjf%nrec(1,iaa), & 360 366 & sdjf%imap, sdjf%igrd, sdjf%ibdy, sdjf%ltotvel, sdjf%lzint, Kmm ) 361 367 ENDIF 362 368 ELSE IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 363 369 CALL wgt_list( sdjf, iw ) 364 IF( sdjf%ln_tint ) THEN ; CALL fld_interp( sdjf%num, sdjf%clvar, iw, ipk, sdjf%fdta(:,:,:,2), & 365 & sdjf%nrec_a(1), sdjf%lsmname ) 366 ELSE ; CALL fld_interp( sdjf%num, sdjf%clvar, iw, ipk, sdjf%fnow(:,:,: ), & 367 & sdjf%nrec_a(1), sdjf%lsmname ) 370 IF( sdjf%ln_tint ) THEN ; CALL fld_interp( sdjf%num, sdjf%clvar, iw, ipk, sdjf%fdta(:,:,:,iaa), & 371 & sdjf%nrec(1,iaa), sdjf%lsmname ) 372 CALL lbc_lnk( 'fldread', sdjf%fdta(:,:,:,iaa), 'T', 1._wp, kfillmode = jpfillcopy ) 373 ELSE ; CALL fld_interp( sdjf%num, sdjf%clvar, iw, ipk, sdjf%fnow(:,:,: ), & 374 & sdjf%nrec(1,iaa), sdjf%lsmname ) 375 CALL lbc_lnk( 'fldread', sdjf%fnow(:,:,: ), 'T', 1._wp, kfillmode = jpfillcopy ) 368 376 ENDIF 369 377 ELSE … … 382 390 IF( lk_c1d .AND. lmoor ) THEN 383 391 IF( sdjf%ln_tint ) THEN 384 CALL iom_get( sdjf%num, sdjf%clvar, sdjf%fdta(2,2,1, 2), sdjf%nrec_a(1) )385 CALL lbc_lnk( 'fldread', sdjf%fdta(:,:,1, 2),'Z',1.)392 CALL iom_get( sdjf%num, sdjf%clvar, sdjf%fdta(2,2,1,iaa), sdjf%nrec(1,iaa) ) 393 CALL lbc_lnk( 'fldread', sdjf%fdta(:,:,1,iaa),'T',1., kfillmode = jpfillcopy ) 386 394 ELSE 387 CALL iom_get( sdjf%num, sdjf%clvar, sdjf%fnow(2,2,1 ), sdjf%nrec_a(1) )388 CALL lbc_lnk( 'fldread', sdjf%fnow(:,:,1 ),'Z',1.)395 CALL iom_get( sdjf%num, sdjf%clvar, sdjf%fnow(2,2,1 ), sdjf%nrec(1,iaa) ) 396 CALL lbc_lnk( 'fldread', sdjf%fnow(:,:,1 ),'T',1., kfillmode = jpfillcopy ) 389 397 ENDIF 390 398 ELSE 391 IF( sdjf%ln_tint ) THEN ; CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_a(1) ) 392 ELSE ; CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fnow(:,:,1 ), sdjf%nrec_a(1) ) 399 IF( sdjf%ln_tint ) THEN 400 CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fdta(:,:,1,iaa), sdjf%nrec(1,iaa), kfill = jpfillcopy ) 401 ELSE 402 CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fnow(:,:,1 ), sdjf%nrec(1,iaa), kfill = jpfillcopy ) 393 403 ENDIF 394 404 ENDIF … … 396 406 IF(lk_c1d .AND. lmoor ) THEN 397 407 IF( sdjf%ln_tint ) THEN 398 CALL iom_get( sdjf%num, jpdom_unknown, sdjf%clvar, sdjf%fdta(2,2,:, 2), sdjf%nrec_a(1) )399 CALL lbc_lnk( 'fldread', sdjf%fdta(:,:,:, 2),'Z',1.)408 CALL iom_get( sdjf%num, jpdom_unknown, sdjf%clvar, sdjf%fdta(2,2,:,iaa), sdjf%nrec(1,iaa) ) 409 CALL lbc_lnk( 'fldread', sdjf%fdta(:,:,:,iaa),'T',1., kfillmode = jpfillcopy ) 400 410 ELSE 401 CALL iom_get( sdjf%num, jpdom_unknown, sdjf%clvar, sdjf%fnow(2,2,: ), sdjf%nrec_a(1) )402 CALL lbc_lnk( 'fldread', sdjf%fnow(:,:,: ),'Z',1.)411 CALL iom_get( sdjf%num, jpdom_unknown, sdjf%clvar, sdjf%fnow(2,2,: ), sdjf%nrec(1,iaa) ) 412 CALL lbc_lnk( 'fldread', sdjf%fnow(:,:,: ),'T',1., kfillmode = jpfillcopy ) 403 413 ENDIF 404 414 ELSE 405 IF( sdjf%ln_tint ) THEN ; CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) ) 406 ELSE ; CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fnow(:,:,: ), sdjf%nrec_a(1) ) 415 IF( sdjf%ln_tint ) THEN 416 CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fdta(:,:,:,iaa), sdjf%nrec(1,iaa), kfill = jpfillcopy ) 417 ELSE 418 CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fnow(:,:,: ), sdjf%nrec(1,iaa), kfill = jpfillcopy ) 407 419 ENDIF 408 420 ENDIF … … 410 422 ENDIF 411 423 ! 412 sdjf%rotn( 2) = .false. ! vector not yet rotated424 sdjf%rotn(iaa) = .false. ! vector not yet rotated 413 425 ! 414 426 END SUBROUTINE fld_get … … 941 953 IF( sdjf%num <= 0 .OR. .NOT. sdjf%ln_clim ) THEN 942 954 IF( sdjf%num > 0 ) CALL iom_close( sdjf%num ) ! close file if already open 943 CALL iom_open( sdjf%clname, sdjf%num, ldstop = llstop, ldiof = LEN (TRIM(sdjf%wgtname)) > 0 )955 CALL iom_open( sdjf%clname, sdjf%num, ldstop = llstop, ldiof = LEN_TRIM(sdjf%wgtname) > 0 ) 944 956 ENDIF 945 957 ! … … 963 975 ENDIF 964 976 ! 965 CALL iom_open( sdjf%clname, sdjf%num, ldiof = LEN (TRIM(sdjf%wgtname)) > 0 )977 CALL iom_open( sdjf%clname, sdjf%num, ldiof = LEN_TRIM(sdjf%wgtname) > 0 ) 966 978 ! 967 979 ENDIF … … 998 1010 sdf(jf)%cltype = sdf_n(jf)%cltype 999 1011 sdf(jf)%num = -1 1012 sdf(jf)%nbb = 1 ! start with before data in 1 1013 sdf(jf)%naa = 2 ! start with after data in 2 1000 1014 sdf(jf)%wgtname = " " 1001 1015 IF( LEN( TRIM(sdf_n(jf)%wname) ) > 0 ) sdf(jf)%wgtname = TRIM( cdir )//sdf_n(jf)%wname … … 1050 1064 !!---------------------------------------------------------------------- 1051 1065 TYPE( FLD ), INTENT(in ) :: sd ! field with name of weights file 1052 INTEGER , INTENT( inout) :: kwgt ! index of weights1066 INTEGER , INTENT( out) :: kwgt ! index of weights 1053 1067 ! 1054 1068 INTEGER :: kw, nestid ! local integer 1055 LOGICAL :: found ! local logical1056 1069 !!---------------------------------------------------------------------- 1057 1070 ! 1058 1071 !! search down linked list 1059 1072 !! weights filename is either present or we hit the end of the list 1060 found = .FALSE.1061 1073 ! 1062 1074 !! because agrif nest part of filenames are now added in iom_open … … 1068 1080 #endif 1069 1081 DO kw = 1, nxt_wgt-1 1070 IF( TRIM(ref_wgts(kw)%wgtname) == TRIM(sd%wgtname).AND. &1071 ref_wgts(kw)%nestid == nestid) THEN1082 IF( ref_wgts(kw)%wgtname == sd%wgtname .AND. & 1083 ref_wgts(kw)%nestid == nestid) THEN 1072 1084 kwgt = kw 1073 found = .TRUE. 1074 EXIT 1085 RETURN 1075 1086 ENDIF 1076 1087 END DO 1077 IF( .NOT.found ) THEN 1078 kwgt = nxt_wgt 1079 CALL fld_weight( sd ) 1080 ENDIF 1088 kwgt = nxt_wgt 1089 CALL fld_weight( sd ) 1081 1090 ! 1082 1091 END SUBROUTINE wgt_list … … 1121 1130 TYPE( FLD ), INTENT(in) :: sd ! field with name of weights file 1122 1131 !! 1123 INTEGER :: j n! dummy loop indices1132 INTEGER :: ji,jj,jn ! dummy loop indices 1124 1133 INTEGER :: inum ! local logical unit 1125 1134 INTEGER :: id ! local variable id … … 1127 1136 INTEGER :: zwrap ! local integer 1128 1137 LOGICAL :: cyclical ! 1129 CHARACTER (len=5) :: aname !1130 INTEGER , DIMENSION( :), ALLOCATABLE:: ddims1131 INTEGER , DIMENSION(jpi,jpj) :: data_src1138 CHARACTER (len=5) :: clname ! 1139 INTEGER , DIMENSION(4) :: ddims 1140 INTEGER :: isrc 1132 1141 REAL(wp), DIMENSION(jpi,jpj) :: data_tmp 1133 1142 !!---------------------------------------------------------------------- … … 1142 1151 !! current weights file 1143 1152 1144 !! open input data file (non-model grid) 1145 CALL iom_open( sd%clname, inum, ldiof = LEN(TRIM(sd%wgtname)) > 0 ) 1146 1147 !! get dimensions: we consider 2D data as 3D data with vertical dim size = 1 1148 IF( SIZE(sd%fnow, 3) > 0 ) THEN 1149 ALLOCATE( ddims(4) ) 1150 ELSE 1151 ALLOCATE( ddims(3) ) 1152 ENDIF 1153 id = iom_varid( inum, sd%clvar, ddims ) 1154 1155 !! close it 1156 CALL iom_close( inum ) 1153 !! get data grid dimensions 1154 id = iom_varid( sd%num, sd%clvar, ddims ) 1157 1155 1158 1156 !! now open the weights file 1159 1160 1157 CALL iom_open ( sd%wgtname, inum ) ! interpolation weights 1161 1158 IF( inum > 0 ) THEN … … 1193 1190 !! two possible cases: bilinear (4 weights) or bicubic (16 weights) 1194 1191 id = iom_varid(inum, 'src05', ldstop=.FALSE.) 1195 IF( id <= 0) THEN 1196 ref_wgts(nxt_wgt)%numwgt = 4 1197 ELSE 1198 ref_wgts(nxt_wgt)%numwgt = 16 1199 ENDIF 1200 1201 ALLOCATE( ref_wgts(nxt_wgt)%data_jpi(jpi,jpj,4) ) 1202 ALLOCATE( ref_wgts(nxt_wgt)%data_jpj(jpi,jpj,4) ) 1203 ALLOCATE( ref_wgts(nxt_wgt)%data_wgt(jpi,jpj,ref_wgts(nxt_wgt)%numwgt) ) 1192 IF( id <= 0 ) THEN ; ref_wgts(nxt_wgt)%numwgt = 4 1193 ELSE ; ref_wgts(nxt_wgt)%numwgt = 16 1194 ENDIF 1195 1196 ALLOCATE( ref_wgts(nxt_wgt)%data_jpi(Nis0:Nie0,Njs0:Nje0,4) ) 1197 ALLOCATE( ref_wgts(nxt_wgt)%data_jpj(Nis0:Nie0,Njs0:Nje0,4) ) 1198 ALLOCATE( ref_wgts(nxt_wgt)%data_wgt(Nis0:Nie0,Njs0:Nje0,ref_wgts(nxt_wgt)%numwgt) ) 1204 1199 1205 1200 DO jn = 1,4 1206 aname = ' ' 1207 WRITE(aname,'(a3,i2.2)') 'src',jn 1208 data_tmp(:,:) = 0 1209 CALL iom_get ( inum, jpdom_global, aname, data_tmp(:,:) ) 1210 data_src(:,:) = INT(data_tmp(:,:)) 1211 ref_wgts(nxt_wgt)%data_jpj(:,:,jn) = 1 + (data_src(:,:)-1) / ref_wgts(nxt_wgt)%ddims(1) 1212 ref_wgts(nxt_wgt)%data_jpi(:,:,jn) = data_src(:,:) - ref_wgts(nxt_wgt)%ddims(1)*(ref_wgts(nxt_wgt)%data_jpj(:,:,jn)-1) 1201 WRITE(clname,'(a3,i2.2)') 'src',jn 1202 CALL iom_get ( inum, jpdom_global, clname, data_tmp(:,:), cd_type = 'Z' ) ! no call to lbc_lnk 1203 DO_2D_00_00 1204 !!$ isrc = NINT(data_tmp(ji,jj)) - 1 1205 isrc = INT(data_tmp(ji,jj)) - 1 1206 ref_wgts(nxt_wgt)%data_jpi(ji,jj,jn) = 1 + MOD(isrc, ref_wgts(nxt_wgt)%ddims(1)) 1207 ref_wgts(nxt_wgt)%data_jpj(ji,jj,jn) = 1 + isrc / ref_wgts(nxt_wgt)%ddims(1) 1208 END_2D 1213 1209 END DO 1214 1210 1215 1211 DO jn = 1, ref_wgts(nxt_wgt)%numwgt 1216 aname = ' ' 1217 WRITE(aname,'(a3,i2.2)') 'wgt',jn 1218 ref_wgts(nxt_wgt)%data_wgt(:,:,jn) = 0.0 1219 CALL iom_get ( inum, jpdom_global, aname, ref_wgts(nxt_wgt)%data_wgt(:,:,jn) ) 1212 WRITE(clname,'(a3,i2.2)') 'wgt',jn 1213 CALL iom_get ( inum, jpdom_global, clname, data_tmp(:,:), cd_type = 'Z' ) ! no call to lbc_lnk 1214 DO_2D_00_00 1215 ref_wgts(nxt_wgt)%data_wgt(ji,jj,jn) = data_tmp(ji,jj) 1216 END_2D 1220 1217 END DO 1221 1218 CALL iom_close (inum) 1222 1219 1223 1220 ! find min and max indices in grid 1224 ref_wgts(nxt_wgt)%botleft( 1) = MINVAL(ref_wgts(nxt_wgt)%data_jpi(:,:,:))1225 ref_wgts(nxt_wgt)%botleft( 2) = MINVAL(ref_wgts(nxt_wgt)%data_jpj(:,:,:))1221 ref_wgts(nxt_wgt)%botleft( 1) = MINVAL(ref_wgts(nxt_wgt)%data_jpi(:,:,:)) 1222 ref_wgts(nxt_wgt)%botleft( 2) = MINVAL(ref_wgts(nxt_wgt)%data_jpj(:,:,:)) 1226 1223 ref_wgts(nxt_wgt)%topright(1) = MAXVAL(ref_wgts(nxt_wgt)%data_jpi(:,:,:)) 1227 1224 ref_wgts(nxt_wgt)%topright(2) = MAXVAL(ref_wgts(nxt_wgt)%data_jpj(:,:,:)) … … 1247 1244 CALL ctl_stop( ' fld_weight : unable to read the file ' ) 1248 1245 ENDIF 1249 1250 DEALLOCATE (ddims )1251 1246 ! 1252 1247 END SUBROUTINE fld_weight … … 1358 1353 1359 1354 1360 SUBROUTINE fld_interp( num, clvar, kw, kk, dta, & 1361 & nrec, lsmfile) 1355 SUBROUTINE fld_interp( num, clvar, kw, kk, dta, nrec, lsmfile) 1362 1356 !!--------------------------------------------------------------------- 1363 1357 !! *** ROUTINE fld_interp *** … … 1377 1371 INTEGER, DIMENSION(3) :: rec1_lsm, recn_lsm ! temporary arrays for start and length in case of seaoverland 1378 1372 INTEGER :: ii_lsm1,ii_lsm2,ij_lsm1,ij_lsm2 ! temporary indices 1379 INTEGER :: jk, jn, jm, jir, jjr ! loop counters 1373 INTEGER :: ji, jj, jk, jn, jir, jjr ! loop counters 1374 INTEGER :: ipk 1380 1375 INTEGER :: ni, nj ! lengths 1381 1376 INTEGER :: jpimin,jpiwid ! temporary indices … … 1388 1383 REAL(wp),DIMENSION(:,:,:), ALLOCATABLE :: ztmp_fly_dta ! local array of values on input grid 1389 1384 !!---------------------------------------------------------------------- 1385 ipk = SIZE(dta, 3) 1390 1386 ! 1391 1387 !! for weighted interpolation we have weights at four corners of a box surrounding … … 1417 1413 1418 1414 1419 IF( LEN ( TRIM(lsmfile)) > 0 ) THEN1415 IF( LEN_TRIM(lsmfile) > 0 ) THEN 1420 1416 !! indeces for ztmp_fly_dta 1421 1417 ! -------------------------- … … 1476 1472 !! first four weights common to both bilinear and bicubic 1477 1473 !! data_jpi, data_jpj have already been shifted to (1,1) corresponding to botleft 1478 !! note that we have to offset by 1 into fly_dta array because of halo 1479 dta(:,:,:) = 0.0 1480 DO jk = 1,4 1481 DO jn = 1, jpj 1482 DO jm = 1,jpi 1483 ni = ref_wgts(kw)%data_jpi(jm,jn,jk) 1484 nj = ref_wgts(kw)%data_jpj(jm,jn,jk) 1485 dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk) * ref_wgts(kw)%fly_dta(ni+1,nj+1,:) 1486 END DO 1487 END DO 1474 !! note that we have to offset by 1 into fly_dta array because of halo added to fly_dta (rec1 definition) 1475 dta(:,:,:) = 0._wp 1476 DO jn = 1,4 1477 DO_3D_00_00( 1,ipk ) 1478 ni = ref_wgts(kw)%data_jpi(ji,jj,jn) + 1 1479 nj = ref_wgts(kw)%data_jpj(ji,jj,jn) + 1 1480 dta(ji,jj,jk) = dta(ji,jj,jk) + ref_wgts(kw)%data_wgt(ji,jj,jn) * ref_wgts(kw)%fly_dta(ni,nj,jk) 1481 END_3D 1488 1482 END DO 1489 1483 1490 1484 IF(ref_wgts(kw)%numwgt .EQ. 16) THEN 1491 1485 1492 !! fix up halo points that we couldnt read from file 1493 IF( jpi1 == 2 ) THEN 1494 ref_wgts(kw)%fly_dta(jpi1-1,:,:) = ref_wgts(kw)%fly_dta(jpi1,:,:) 1495 ENDIF 1496 IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN 1497 ref_wgts(kw)%fly_dta(jpi2+1,:,:) = ref_wgts(kw)%fly_dta(jpi2,:,:) 1498 ENDIF 1499 IF( jpj1 == 2 ) THEN 1500 ref_wgts(kw)%fly_dta(:,jpj1-1,:) = ref_wgts(kw)%fly_dta(:,jpj1,:) 1501 ENDIF 1502 IF( jpj2 + jpjmin - 1 == ref_wgts(kw)%ddims(2)+1 .AND. jpj2 .lt. jpjwid+2 ) THEN 1503 ref_wgts(kw)%fly_dta(:,jpj2+1,:) = 2.0*ref_wgts(kw)%fly_dta(:,jpj2,:) - ref_wgts(kw)%fly_dta(:,jpj2-1,:) 1504 ENDIF 1505 1506 !! if data grid is cyclic we can do better on east-west edges 1507 !! but have to allow for whether first and last columns are coincident 1508 IF( ref_wgts(kw)%cyclic ) THEN 1509 rec1(2) = MAX( jpjmin-1, 1 ) 1510 recn(1) = 1 1511 recn(2) = MIN( jpjwid+2, ref_wgts(kw)%ddims(2)-rec1(2)+1 ) 1512 jpj1 = 2 + rec1(2) - jpjmin 1513 jpj2 = jpj1 + recn(2) - 1 1514 IF( jpi1 == 2 ) THEN 1515 rec1(1) = ref_wgts(kw)%ddims(1) - ref_wgts(kw)%overlap 1516 CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,:), nrec, kstart = rec1, kcount = recn) 1517 ref_wgts(kw)%fly_dta(jpi1-1,jpj1:jpj2,:) = ref_wgts(kw)%col(1,jpj1:jpj2,:) 1518 ENDIF 1519 IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN 1520 rec1(1) = 1 + ref_wgts(kw)%overlap 1521 CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,:), nrec, kstart = rec1, kcount = recn) 1522 ref_wgts(kw)%fly_dta(jpi2+1,jpj1:jpj2,:) = ref_wgts(kw)%col(1,jpj1:jpj2,:) 1523 ENDIF 1524 ENDIF 1525 1526 ! gradient in the i direction 1527 DO jk = 1,4 1528 DO jn = 1, jpj 1529 DO jm = 1,jpi 1530 ni = ref_wgts(kw)%data_jpi(jm,jn,jk) 1531 nj = ref_wgts(kw)%data_jpj(jm,jn,jk) 1532 dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk+4) * 0.5 * & 1533 (ref_wgts(kw)%fly_dta(ni+2,nj+1,:) - ref_wgts(kw)%fly_dta(ni,nj+1,:)) 1534 END DO 1535 END DO 1536 END DO 1537 1538 ! gradient in the j direction 1539 DO jk = 1,4 1540 DO jn = 1, jpj 1541 DO jm = 1,jpi 1542 ni = ref_wgts(kw)%data_jpi(jm,jn,jk) 1543 nj = ref_wgts(kw)%data_jpj(jm,jn,jk) 1544 dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk+8) * 0.5 * & 1545 (ref_wgts(kw)%fly_dta(ni+1,nj+2,:) - ref_wgts(kw)%fly_dta(ni+1,nj,:)) 1546 END DO 1547 END DO 1548 END DO 1549 1550 ! gradient in the ij direction 1551 DO jk = 1,4 1552 DO jn = 1, jpj 1553 DO jm = 1,jpi 1554 ni = ref_wgts(kw)%data_jpi(jm,jn,jk) 1555 nj = ref_wgts(kw)%data_jpj(jm,jn,jk) 1556 dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk+12) * 0.25 * ( & 1557 (ref_wgts(kw)%fly_dta(ni+2,nj+2,:) - ref_wgts(kw)%fly_dta(ni ,nj+2,:)) - & 1558 (ref_wgts(kw)%fly_dta(ni+2,nj ,:) - ref_wgts(kw)%fly_dta(ni ,nj ,:))) 1559 END DO 1560 END DO 1486 !! fix up halo points that we couldnt read from file 1487 IF( jpi1 == 2 ) THEN 1488 ref_wgts(kw)%fly_dta(jpi1-1,:,:) = ref_wgts(kw)%fly_dta(jpi1,:,:) 1489 ENDIF 1490 IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN 1491 ref_wgts(kw)%fly_dta(jpi2+1,:,:) = ref_wgts(kw)%fly_dta(jpi2,:,:) 1492 ENDIF 1493 IF( jpj1 == 2 ) THEN 1494 ref_wgts(kw)%fly_dta(:,jpj1-1,:) = ref_wgts(kw)%fly_dta(:,jpj1,:) 1495 ENDIF 1496 IF( jpj2 + jpjmin - 1 == ref_wgts(kw)%ddims(2)+1 .AND. jpj2 .LT. jpjwid+2 ) THEN 1497 ref_wgts(kw)%fly_dta(:,jpj2+1,:) = 2.0*ref_wgts(kw)%fly_dta(:,jpj2,:) - ref_wgts(kw)%fly_dta(:,jpj2-1,:) 1498 ENDIF 1499 1500 !! if data grid is cyclic we can do better on east-west edges 1501 !! but have to allow for whether first and last columns are coincident 1502 IF( ref_wgts(kw)%cyclic ) THEN 1503 rec1(2) = MAX( jpjmin-1, 1 ) 1504 recn(1) = 1 1505 recn(2) = MIN( jpjwid+2, ref_wgts(kw)%ddims(2)-rec1(2)+1 ) 1506 jpj1 = 2 + rec1(2) - jpjmin 1507 jpj2 = jpj1 + recn(2) - 1 1508 IF( jpi1 == 2 ) THEN 1509 rec1(1) = ref_wgts(kw)%ddims(1) - ref_wgts(kw)%overlap 1510 CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,:), nrec, kstart = rec1, kcount = recn) 1511 ref_wgts(kw)%fly_dta(jpi1-1,jpj1:jpj2,:) = ref_wgts(kw)%col(1,jpj1:jpj2,:) 1512 ENDIF 1513 IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN 1514 rec1(1) = 1 + ref_wgts(kw)%overlap 1515 CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,:), nrec, kstart = rec1, kcount = recn) 1516 ref_wgts(kw)%fly_dta(jpi2+1,jpj1:jpj2,:) = ref_wgts(kw)%col(1,jpj1:jpj2,:) 1517 ENDIF 1518 ENDIF 1519 ! 1520 !!$ DO jn = 1,4 1521 !!$ DO_3D_00_00( 1,ipk ) 1522 !!$ ni = ref_wgts(kw)%data_jpi(ji,jj,jn) + 1 1523 !!$ nj = ref_wgts(kw)%data_jpj(ji,jj,jn) + 1 1524 !!$ dta(ji,jj,jk) = dta(ji,jj,jk) & 1525 !!$ ! gradient in the i direction 1526 !!$ & + ref_wgts(kw)%data_wgt(ji,jj,jn+4) * 0.5_wp * & 1527 !!$ & (ref_wgts(kw)%fly_dta(ni+1,nj ,jk) - ref_wgts(kw)%fly_dta(ni-1,nj ,jk)) & 1528 !!$ ! gradient in the j direction 1529 !!$ & + ref_wgts(kw)%data_wgt(ji,jj,jn+8) * 0.5_wp * & 1530 !!$ & (ref_wgts(kw)%fly_dta(ni ,nj+1,jk) - ref_wgts(kw)%fly_dta(ni ,nj-1,jk)) & 1531 !!$ ! gradient in the ij direction 1532 !!$ & + ref_wgts(kw)%data_wgt(ji,jj,jn+12) * 0.25_wp * & 1533 !!$ & ((ref_wgts(kw)%fly_dta(ni+1,nj+1,jk) - ref_wgts(kw)%fly_dta(ni-1,nj+1,jk)) - & 1534 !!$ & (ref_wgts(kw)%fly_dta(ni+1,nj-1,jk) - ref_wgts(kw)%fly_dta(ni-1,nj-1,jk))) 1535 !!$ END_3D 1536 !!$ END DO 1537 ! 1538 DO jn = 1,4 1539 DO_3D_00_00( 1,ipk ) 1540 ni = ref_wgts(kw)%data_jpi(ji,jj,jn) 1541 nj = ref_wgts(kw)%data_jpj(ji,jj,jn) 1542 ! gradient in the i direction 1543 dta(ji,jj,jk) = dta(ji,jj,jk) + ref_wgts(kw)%data_wgt(ji,jj,jn+4) * 0.5_wp * & 1544 & (ref_wgts(kw)%fly_dta(ni+2,nj+1,jk) - ref_wgts(kw)%fly_dta(ni ,nj+1,jk)) 1545 END_3D 1546 END DO 1547 DO jn = 1,4 1548 DO_3D_00_00( 1,ipk ) 1549 ni = ref_wgts(kw)%data_jpi(ji,jj,jn) 1550 nj = ref_wgts(kw)%data_jpj(ji,jj,jn) 1551 ! gradient in the j direction 1552 dta(ji,jj,jk) = dta(ji,jj,jk) + ref_wgts(kw)%data_wgt(ji,jj,jn+8) * 0.5_wp * & 1553 & (ref_wgts(kw)%fly_dta(ni+1,nj+2,jk) - ref_wgts(kw)%fly_dta(ni+1,nj ,jk)) 1554 END_3D 1555 END DO 1556 DO jn = 1,4 1557 DO_3D_00_00( 1,ipk ) 1558 ni = ref_wgts(kw)%data_jpi(ji,jj,jn) 1559 nj = ref_wgts(kw)%data_jpj(ji,jj,jn) 1560 ! gradient in the ij direction 1561 dta(ji,jj,jk) = dta(ji,jj,jk) + ref_wgts(kw)%data_wgt(ji,jj,jn+12) * 0.25_wp * ( & 1562 & (ref_wgts(kw)%fly_dta(ni+2,nj+2,jk) - ref_wgts(kw)%fly_dta(ni ,nj+2,jk)) - & 1563 & (ref_wgts(kw)%fly_dta(ni+2,nj ,jk) - ref_wgts(kw)%fly_dta(ni ,nj ,jk))) 1564 END_3D 1561 1565 END DO 1562 1566 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/TRA/traadv_fct.F90
r12489 r12866 160 160 END_2D 161 161 ELSE ! no cavities: only at the ocean surface 162 zwz(:,:,1) = pW(:,:,1) * pt(:,:,1,jn,Kbb) 162 DO_2D_11_11 163 zwz(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kbb) 164 END_2D 163 165 ENDIF 164 166 ENDIF -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/USR/usrdef_fmask.F90
r12377 r12866 68 68 ! 69 69 IF(lwp) WRITE(numout,*) ' Gibraltar ' 70 ij0 = 101 ; ij1 = 101 ! Gibraltar strait : partial slip (pfmsk=0.5)70 ij0 = 101+1 ; ij1 = 101+1 ! Gibraltar strait : partial slip (pfmsk=0.5) 71 71 ii0 = 139 ; ii1 = 140 ; pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 0.5_wp 72 ij0 = 102 ; ij1 = 10272 ij0 = 102+1 ; ij1 = 102+1 73 73 ii0 = 139 ; ii1 = 140 ; pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 0.5_wp 74 74 ! 75 75 IF(lwp) WRITE(numout,*) ' Bab el Mandeb ' 76 ij0 = 87 ; ij1 = 88! Bab el Mandeb : partial slip (pfmsk=1)76 ij0 = 87+1 ; ij1 = 88+1 ! Bab el Mandeb : partial slip (pfmsk=1) 77 77 ii0 = 160 ; ii1 = 160 ; pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 1._wp 78 ij0 = 88 ; ij1 = 8878 ij0 = 88+1 ; ij1 = 88+1 79 79 ii0 = 159 ; ii1 = 159 ; pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 1._wp 80 80 ! … … 94 94 !!gm ! Currently these hard-wired indices relate to configuration with extend grid (jpjglo=332) 95 95 ! 96 isrow = 332 - jpjglo96 isrow = 332 - Nj0glo - 2 97 97 ! 98 98 IF(lwp) WRITE(numout,*) -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/USR/usrdef_hgr.F90
r12489 r12866 13 13 !! usr_def_hgr : initialize the horizontal mesh 14 14 !!---------------------------------------------------------------------- 15 USE dom_oce , ONLY: nimpp, njmpp! ocean space and time domain15 USE dom_oce ! ocean space and time domain 16 16 USE par_oce ! ocean space and time domain 17 17 USE phycst ! physical constants … … 90 90 zcos_alpha = SQRT( 2._wp ) * 0.5_wp 91 91 ze1deg = ze1 / (ra * rad) 92 zlam0 = zlam1 + zcos_alpha * ze1deg * REAL( jpjglo-2 , wp )93 zphi0 = zphi1 + zsin_alpha * ze1deg * REAL( jpjglo-2, wp )92 zlam0 = zlam1 + zcos_alpha * ze1deg * REAL( Ni0glo-1 , wp ) ! -1 to keep same results -> to be removed... 93 zphi0 = zphi1 + zsin_alpha * ze1deg * REAL( Nj0glo-1 , wp ) 94 94 95 95 #if defined key_agrif … … 115 115 ! 116 116 DO_2D_11_11 117 zim1 = REAL( ji + nimpp - 1 ) - 1. ; zim05 = REAL( ji + nimpp - 1 ) - 1.5118 zjm1 = REAL( jj + njmpp - 1 ) - 1. ; zjm05 = REAL( jj + njmpp - 1 ) - 1.5117 zim1 = REAL( mig(ji)-1, wp ) - 1. ; zim05 = REAL( mig(ji)-1, wp ) - 1.5 ! -1 to keep same results -> to be removed... 118 zjm1 = REAL( mjg(jj)-1, wp ) - 1. ; zjm05 = REAL( mjg(jj)-1, wp ) - 1.5 ! -1 to keep same results -> to be removed... 119 119 ! 120 120 !glamt(i,j) longitude at T-point -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/USR/usrdef_nam.F90
r12377 r12866 70 70 kk_cfg = nn_GYRE 71 71 ! 72 kpi = 30 * nn_GYRE + 2! Global Domain size73 kpj = 20 * nn_GYRE + 272 kpi = 30 * nn_GYRE + 1 ! Global Domain size 73 kpj = 20 * nn_GYRE + 1 74 74 #if defined key_agrif 75 75 IF( .NOT. Agrif_Root() ) THEN 76 kpi = nbcellsx + 2 + 2*nbghostcells77 kpj = nbcellsy + 2 + 2*nbghostcells76 kpi = nbcellsx + 2*nbghostcells 77 kpj = nbcellsy + 2*nbghostcells 78 78 ENDIF 79 79 #endif … … 93 93 IF( Agrif_Root() ) THEN 94 94 #endif 95 WRITE(numout,*) ' jpiglo = 30*nn_GYRE+2 jpiglo = ', kpi96 WRITE(numout,*) ' jpjglo = 20*nn_GYRE+2 jpjglo = ', kpj95 WRITE(numout,*) ' Ni0glo = 30*nn_GYRE Ni0glo = ', kpi 96 WRITE(numout,*) ' Nj0glo = 20*nn_GYRE Nj0glo = ', kpj 97 97 #if defined key_agrif 98 98 ENDIF 99 99 #endif 100 WRITE(numout,*) ' number of model levels 100 WRITE(numout,*) ' number of model levels jpkglo = ', kpk 101 101 WRITE(numout,*) ' ' 102 WRITE(numout,*) ' Lateral b.c. of the global domain set to closed 102 WRITE(numout,*) ' Lateral b.c. of the global domain set to closed jperio = ', kperio 103 103 ENDIF 104 104 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/USR/usrdef_zgr.F90
r12377 r12866 198 198 IF(lwp) WRITE(numout,*) ' GYRE case : closed flat box ocean without ocean cavities' 199 199 ! 200 z2d(:,:) = REAL( jpkm1 , wp ) ! flat bottom 200 z2d(:,:) = REAL( jpkm1 , wp ) ! flat bottom 201 z2d(mi0( 1 ):mi1(jpiglo),mj0(Njs0):mj1( Njs0 )) = 0._wp ! line number Njs0 at 0 202 z2d(mi0(Nis0):mi1( Nis0 ),mj0( 1 ):mj1(jpjglo)) = 0._wp ! column number Nis0 at 0 201 203 ! 202 204 CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. ) ! set surrounding land to zero (here jperio=0 ==>> closed) -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OFF/dtadyn.F90
r12739 r12866 122 122 ! 123 123 IF( kt == nit000 ) THEN ; nprevrec = 0 124 ELSE ; nprevrec = sf_dyn(jf_tem)%nrec _a(2)124 ELSE ; nprevrec = sf_dyn(jf_tem)%nrec(2,sf_dyn(jf_tem)%naa) 125 125 ENDIF 126 126 CALL fld_read( kt, 1, sf_dyn ) != read data at kt time step ==! … … 434 434 ! 435 435 IF( kt == nit000 ) THEN ; nprevrec = 0 436 ELSE ; nprevrec = sf_dyn(jf_tem)%nrec _a(2)436 ELSE ; nprevrec = sf_dyn(jf_tem)%nrec(2,sf_dyn(jf_tem)%naa) 437 437 ENDIF 438 438 CALL fld_read( kt, 1, sf_dyn ) != read data at kt time step ==! … … 686 686 !!--------------------------------------------------------------------- 687 687 ! 688 IF( sf_dyn(jf_tem)%ln_tint ) THEN ! Computes slopes (here avt is used as workspace) 688 IF( sf_dyn(jf_tem)%ln_tint ) THEN ! Computes slopes (here avt is used as workspace) 689 ! 689 690 IF( kt == nit000 ) THEN 690 691 IF(lwp) WRITE(numout,*) ' Compute new slopes at kt = ', kt 691 zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:, 1) * tmask(:,:,:) ! temperature692 zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:, 1) * tmask(:,:,:) ! salinity693 avt(:,:,:) = sf_dyn(jf_avt)%fdta(:,:,:, 1) * tmask(:,:,:) ! vertical diffusive coef.692 zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:,sf_dyn(jf_tem)%nbb) * tmask(:,:,:) ! temperature 693 zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,sf_dyn(jf_sal)%nbb) * tmask(:,:,:) ! salinity 694 avt(:,:,:) = sf_dyn(jf_avt)%fdta(:,:,:,sf_dyn(jf_avt)%nbb) * tmask(:,:,:) ! vertical diffusive coef. 694 695 CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj, Kbb, Kmm ) 695 696 uslpdta (:,:,:,1) = zuslp (:,:,:) … … 698 699 wslpjdta(:,:,:,1) = zwslpj(:,:,:) 699 700 ! 700 zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:, 2) * tmask(:,:,:) ! temperature701 zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:, 2) * tmask(:,:,:) ! salinity702 avt(:,:,:) = sf_dyn(jf_avt)%fdta(:,:,:, 2) * tmask(:,:,:) ! vertical diffusive coef.701 zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:,sf_dyn(jf_tem)%naa) * tmask(:,:,:) ! temperature 702 zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,sf_dyn(jf_sal)%naa) * tmask(:,:,:) ! salinity 703 avt(:,:,:) = sf_dyn(jf_avt)%fdta(:,:,:,sf_dyn(jf_avt)%naa) * tmask(:,:,:) ! vertical diffusive coef. 703 704 CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj, Kbb, Kmm ) 704 705 uslpdta (:,:,:,2) = zuslp (:,:,:) … … 709 710 ! 710 711 iswap = 0 711 IF( sf_dyn(jf_tem)%nrec _a(2) - nprevrec /= 0 ) iswap = 1712 IF( nsecdyn > sf_dyn(jf_tem)%nrec _b(2) .AND. iswap == 1 ) THEN ! read/update the after data712 IF( sf_dyn(jf_tem)%nrec(2,sf_dyn(jf_tem)%naa) - nprevrec /= 0 ) iswap = 1 713 IF( nsecdyn > sf_dyn(jf_tem)%nrec(2,sf_dyn(jf_tem)%nbb) .AND. iswap == 1 ) THEN ! read/update the after data 713 714 IF(lwp) WRITE(numout,*) ' Compute new slopes at kt = ', kt 714 715 uslpdta (:,:,:,1) = uslpdta (:,:,:,2) ! swap the data … … 717 718 wslpjdta(:,:,:,1) = wslpjdta(:,:,:,2) 718 719 ! 719 zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:, 2) * tmask(:,:,:) ! temperature720 zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:, 2) * tmask(:,:,:) ! salinity721 avt(:,:,:) = sf_dyn(jf_avt)%fdta(:,:,:, 2) * tmask(:,:,:) ! vertical diffusive coef.720 zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:,sf_dyn(jf_tem)%naa) * tmask(:,:,:) ! temperature 721 zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,sf_dyn(jf_sal)%naa) * tmask(:,:,:) ! salinity 722 avt(:,:,:) = sf_dyn(jf_avt)%fdta(:,:,:,sf_dyn(jf_avt)%naa) * tmask(:,:,:) ! vertical diffusive coef. 722 723 CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj, Kbb, Kmm ) 723 724 ! … … 731 732 ! 732 733 IF( sf_dyn(jf_tem)%ln_tint ) THEN 733 ztinta = REAL( nsecdyn - sf_dyn(jf_tem)%nrec _b(2), wp ) &734 & / REAL( sf_dyn(jf_tem)%nrec _a(2) - sf_dyn(jf_tem)%nrec_b(2), wp )734 ztinta = REAL( nsecdyn - sf_dyn(jf_tem)%nrec(2,sf_dyn(jf_tem)%nbb), wp ) & 735 & / REAL( sf_dyn(jf_tem)%nrec(2,sf_dyn(jf_tem)%naa) - sf_dyn(jf_tem)%nrec(2,sf_dyn(jf_tem)%nbb), wp ) 735 736 ztintb = 1. - ztinta 736 737 IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN ! Computes slopes (here avt is used as workspace) -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/tests/BENCH/MY_SRC/usrdef_zgr.F90
r12377 r12866 191 191 ! 192 192 z2d(:,:) = REAL( jpkm1 , wp ) ! flat bottom 193 IF( .NOT. (nbondj == 1 .OR. nbondj == 0 .OR. l_Jperio) ) & 194 z2d(mi0( 1 ):mi1(jpiglo),mj0(Njs0):mj1( Njs0 )) = 0._wp ! line number Njs0 at 0 195 IF( .NOT. (nbondi == 1 .OR. nbondi == 0 .OR. l_Iperio) ) & 196 z2d(mi0(Nis0):mi1( Nis0 ),mj0( 1 ):mj1(jpjglo)) = 0._wp ! column number Nis0 at 0 193 197 ! 194 198 IF( jperio == 3 .OR. jperio ==4 ) THEN ! add a small island in the upper corners to avoid model instabilities...
Note: See TracChangeset
for help on using the changeset viewer.
