Changeset 13899 for NEMO/branches/2020/tickets_icb_1900/src/OFF
- Timestamp:
- 2020-11-27T17:26:33+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/tickets_icb_1900
- Files:
-
- 3 edited
-
. (modified) (1 prop)
-
src/OFF/dtadyn.F90 (modified) (15 diffs)
-
src/OFF/nemogcm.F90 (modified) (15 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/tickets_icb_1900
- Property svn:externals
-
NEMO/branches/2020/tickets_icb_1900/src/OFF/dtadyn.F90
r13237 r13899 71 71 INTEGER , SAVE :: jf_uwd ! index of u-transport 72 72 INTEGER , SAVE :: jf_vwd ! index of v-transport 73 INTEGER , SAVE :: jf_wwd ! index of v-transport73 INTEGER , SAVE :: jf_wwd ! index of w-transport 74 74 INTEGER , SAVE :: jf_avt ! index of Kz 75 75 INTEGER , SAVE :: jf_mld ! index of mixed layer deptht … … 128 128 ! 129 129 IF( kt == nit000 ) THEN ; nprevrec = 0 130 ELSE ; nprevrec = sf_dyn(jf_tem)%nrec _a(2)130 ELSE ; nprevrec = sf_dyn(jf_tem)%nrec(2,sf_dyn(jf_tem)%naa) 131 131 ENDIF 132 132 CALL fld_read( kt, 1, sf_dyn ) != read data at kt time step ==! … … 294 294 ! ! fill sf with slf_i and control print 295 295 CALL fld_fill( sf_dyn, slf_d, cn_dir, 'dta_dyn_init', 'Data in file', 'namdta_dyn' ) 296 sf_dyn(jf_uwd)%cltype = 'U' ; sf_dyn(jf_uwd)%zsgn = -1._wp 297 sf_dyn(jf_vwd)%cltype = 'V' ; sf_dyn(jf_vwd)%zsgn = -1._wp 298 ! 299 IF( ln_trabbl ) THEN 300 sf_dyn(jf_ubl)%cltype = 'U' ; sf_dyn(jf_ubl)%zsgn = 1._wp 301 sf_dyn(jf_vbl)%cltype = 'V' ; sf_dyn(jf_vbl)%zsgn = 1._wp 302 END IF 296 303 ! 297 304 ! Open file for each variable to get his number of dimension … … 330 337 iom_varid( numrtr, 'sshn', ldstop = .FALSE. ) > 0 ) THEN 331 338 IF(lwp) WRITE(numout,*) ' ssh(:,:,Kmm) forcing fields read in the restart file for initialisation' 332 CALL iom_get( numrtr, jpdom_auto glo, 'sshn', ssh(:,:,Kmm) )333 CALL iom_get( numrtr, jpdom_auto glo, 'sshb', ssh(:,:,Kbb) )339 CALL iom_get( numrtr, jpdom_auto, 'sshn', ssh(:,:,Kmm) ) 340 CALL iom_get( numrtr, jpdom_auto, 'sshb', ssh(:,:,Kbb) ) 334 341 ELSE 335 342 IF(lwp) WRITE(numout,*) ' ssh(:,:,Kmm) forcing fields read in the restart file for initialisation' 336 343 CALL iom_open( 'restart', inum ) 337 CALL iom_get( inum, jpdom_auto glo, 'sshn', ssh(:,:,Kmm) )338 CALL iom_get( inum, jpdom_auto glo, 'sshb', ssh(:,:,Kbb) )344 CALL iom_get( inum, jpdom_auto, 'sshn', ssh(:,:,Kmm) ) 345 CALL iom_get( inum, jpdom_auto, 'sshb', ssh(:,:,Kbb) ) 339 346 CALL iom_close( inum ) ! close file 340 347 ENDIF … … 367 374 gdepw(:,:,1,Kmm) = 0.0_wp 368 375 369 DO_3D _11_11(2, jpk )376 DO_3D( 1, 1, 1, 1, 2, jpk ) 370 377 ! zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) ! 0 everywhere 371 378 ! tmask = wmask, ie everywhere expect at jk = mikt … … 388 395 IF(lwp) WRITE(numout,*) ' read in the file depht over which runoffs are distributed' 389 396 CALL iom_open ( "runoffs", inum ) ! open file 390 CALL iom_get ( inum, jpdom_ data, 'rodepth', h_rnf ) ! read the river mouth array397 CALL iom_get ( inum, jpdom_global, 'rodepth', h_rnf ) ! read the river mouth array 391 398 CALL iom_close( inum ) ! close file 392 399 ! 393 400 nk_rnf(:,:) = 0 ! set the number of level over which river runoffs are applied 394 DO_2D _11_11401 DO_2D( 1, 1, 1, 1 ) 395 402 IF( h_rnf(ji,jj) > 0._wp ) THEN 396 403 jk = 2 … … 405 412 ENDIF 406 413 END_2D 407 !!st pourquoi on n'utilise pas le gde3w ici plutôt que de faire une boucle ? 408 DO_2D_11_11 414 DO_2D( 1, 1, 1, 1 ) ! set the associated depth 409 415 h_rnf(ji,jj) = 0._wp 410 416 DO jk = 1, nk_rnf(ji,jj) … … 452 458 ! 453 459 IF( kt == nit000 ) THEN ; nprevrec = 0 454 ELSE ; nprevrec = sf_dyn(jf_tem)%nrec _a(2)460 ELSE ; nprevrec = sf_dyn(jf_tem)%nrec(2,sf_dyn(jf_tem)%naa) 455 461 ENDIF 456 462 CALL fld_read( kt, 1, sf_dyn ) != read data at kt time step ==! … … 601 607 gdepw(:,:,1,Kmm) = 0.0_wp 602 608 ! 603 DO_3D _11_11(2, jpk )609 DO_3D( 1, 1, 1, 1, 2, jpk ) 604 610 zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 605 611 gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) … … 681 687 !!---------------------------------------------------------------------- 682 688 ! 683 !!st code dupliqué même remarque que plus haut pourquoi ne pas utiliser gdepw ? 684 DO_2D_11_11 689 DO_2D( 1, 1, 1, 1 ) ! update the depth over which runoffs are distributed 685 690 h_rnf(ji,jj) = 0._wp 686 691 DO jk = 1, nk_rnf(ji,jj) ! recalculates h_rnf to be the depth in metres … … 711 716 !!--------------------------------------------------------------------- 712 717 ! 713 IF( sf_dyn(jf_tem)%ln_tint ) THEN ! Computes slopes (here avt is used as workspace) 718 IF( sf_dyn(jf_tem)%ln_tint ) THEN ! Computes slopes (here avt is used as workspace) 719 ! 714 720 IF( kt == nit000 ) THEN 715 721 IF(lwp) WRITE(numout,*) ' Compute new slopes at kt = ', kt 716 zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:, 1) * tmask(:,:,:) ! temperature717 zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:, 1) * tmask(:,:,:) ! salinity718 avt(:,:,:) = sf_dyn(jf_avt)%fdta(:,:,:, 1) * tmask(:,:,:) ! vertical diffusive coef.722 zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:,sf_dyn(jf_tem)%nbb) * tmask(:,:,:) ! temperature 723 zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,sf_dyn(jf_sal)%nbb) * tmask(:,:,:) ! salinity 724 avt(:,:,:) = sf_dyn(jf_avt)%fdta(:,:,:,sf_dyn(jf_avt)%nbb) * tmask(:,:,:) ! vertical diffusive coef. 719 725 CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj, Kbb, Kmm ) 720 726 uslpdta (:,:,:,1) = zuslp (:,:,:) … … 723 729 wslpjdta(:,:,:,1) = zwslpj(:,:,:) 724 730 ! 725 zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:, 2) * tmask(:,:,:) ! temperature726 zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:, 2) * tmask(:,:,:) ! salinity727 avt(:,:,:) = sf_dyn(jf_avt)%fdta(:,:,:, 2) * tmask(:,:,:) ! vertical diffusive coef.731 zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:,sf_dyn(jf_tem)%naa) * tmask(:,:,:) ! temperature 732 zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,sf_dyn(jf_sal)%naa) * tmask(:,:,:) ! salinity 733 avt(:,:,:) = sf_dyn(jf_avt)%fdta(:,:,:,sf_dyn(jf_avt)%naa) * tmask(:,:,:) ! vertical diffusive coef. 728 734 CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj, Kbb, Kmm ) 729 735 uslpdta (:,:,:,2) = zuslp (:,:,:) … … 734 740 ! 735 741 iswap = 0 736 IF( sf_dyn(jf_tem)%nrec _a(2) - nprevrec /= 0 ) iswap = 1737 IF( nsecdyn > sf_dyn(jf_tem)%nrec _b(2) .AND. iswap == 1 ) THEN ! read/update the after data742 IF( sf_dyn(jf_tem)%nrec(2,sf_dyn(jf_tem)%naa) - nprevrec /= 0 ) iswap = 1 743 IF( nsecdyn > sf_dyn(jf_tem)%nrec(2,sf_dyn(jf_tem)%nbb) .AND. iswap == 1 ) THEN ! read/update the after data 738 744 IF(lwp) WRITE(numout,*) ' Compute new slopes at kt = ', kt 739 745 uslpdta (:,:,:,1) = uslpdta (:,:,:,2) ! swap the data … … 742 748 wslpjdta(:,:,:,1) = wslpjdta(:,:,:,2) 743 749 ! 744 zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:, 2) * tmask(:,:,:) ! temperature745 zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:, 2) * tmask(:,:,:) ! salinity746 avt(:,:,:) = sf_dyn(jf_avt)%fdta(:,:,:, 2) * tmask(:,:,:) ! vertical diffusive coef.750 zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:,sf_dyn(jf_tem)%naa) * tmask(:,:,:) ! temperature 751 zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,sf_dyn(jf_sal)%naa) * tmask(:,:,:) ! salinity 752 avt(:,:,:) = sf_dyn(jf_avt)%fdta(:,:,:,sf_dyn(jf_avt)%naa) * tmask(:,:,:) ! vertical diffusive coef. 747 753 CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj, Kbb, Kmm ) 748 754 ! … … 756 762 ! 757 763 IF( sf_dyn(jf_tem)%ln_tint ) THEN 758 ztinta = REAL( nsecdyn - sf_dyn(jf_tem)%nrec _b(2), wp ) &759 & / REAL( sf_dyn(jf_tem)%nrec _a(2) - sf_dyn(jf_tem)%nrec_b(2), wp )764 ztinta = REAL( nsecdyn - sf_dyn(jf_tem)%nrec(2,sf_dyn(jf_tem)%nbb), wp ) & 765 & / REAL( sf_dyn(jf_tem)%nrec(2,sf_dyn(jf_tem)%naa) - sf_dyn(jf_tem)%nrec(2,sf_dyn(jf_tem)%nbb), wp ) 760 766 ztintb = 1. - ztinta 761 767 IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN ! Computes slopes (here avt is used as workspace) -
NEMO/branches/2020/tickets_icb_1900/src/OFF/nemogcm.F90
r13237 r13899 31 31 USE domqco ! tools for scale factor (dom_qco_r3c routine) 32 32 #endif 33 USE bdy_oce, ONLY : ln_bdy 34 USE bdyini ! open boundary cond. setting (bdy_init routine) 33 USE bdyini ! open boundary cond. setting (bdy_init routine) 35 34 ! ! ocean physics 36 35 USE ldftra ! lateral diffusivity setting (ldf_tra_init routine) … … 41 40 USE sbcmod ! surface boundary condition (sbc_init routine) 42 41 USE phycst ! physical constant (par_cst routine) 42 USE zdfphy ! vertical physics manager (zdf_phy_init routine) 43 43 USE dtadyn ! Lecture and Interpolation of the dynamical fields 44 44 USE trcini ! Initilization of the passive tracers … … 50 50 USE trcnam ! passive tracer : namelist 51 51 USE trcrst ! passive tracer restart 52 USE diaptr ! Need to initialise this as some variables are used in if statements later53 52 USE sbc_oce , ONLY : ln_rnf 54 53 USE sbcrnf ! surface boundary condition : runoffs … … 64 63 USE timing ! Timing 65 64 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 66 USE lbcnfd , ONLY : isendto, nsndto , nfsloop, nfeloop! Setup of north fold exchanges65 USE lbcnfd , ONLY : isendto, nsndto ! Setup of north fold exchanges 67 66 USE step, ONLY : Nbb, Nnn, Naa, Nrhs ! time level indices 67 USE halo_mng 68 68 69 69 IMPLICIT NONE … … 73 73 74 74 CHARACTER (len=64) :: cform_aaa="( /, 'AAAAAAAA', / ) " ! flag for output listing 75 #if defined key_mpp_mpi 76 ! need MPI_Wtime 77 INCLUDE 'mpif.h' 78 #endif 75 79 76 80 !!---------------------------------------------------------------------- … … 96 100 !!---------------------------------------------------------------------- 97 101 INTEGER :: istp ! time step index 102 REAL(wp):: zstptiming ! elapsed time for 1 time step 98 103 !!---------------------------------------------------------------------- 99 104 … … 114 119 ! 115 120 DO WHILE ( istp <= nitend .AND. nstop == 0 ) !== OFF time-stepping ==! 121 122 IF( ln_timing ) THEN 123 zstptiming = MPI_Wtime() 124 IF ( istp == ( nit000 + 1 ) ) elapsed_time = zstptiming 125 IF ( istp == nitend ) elapsed_time = zstptiming - elapsed_time 126 ENDIF 116 127 ! 117 128 IF( istp /= nit000 ) CALL day ( istp ) ! Calendar (day was already called at nit000 in day_init) … … 147 158 #endif 148 159 #endif 149 160 CALL stp_ctl ( istp ) ! Time loop: control and print 150 161 istp = istp + 1 162 163 IF( lwp .AND. ln_timing ) WRITE(numtime,*) 'timing step ', istp-1, ' : ', MPI_Wtime() - zstptiming 164 151 165 END DO 152 166 ! … … 193 207 INTEGER :: ios, ilocal_comm ! local integers 194 208 !! 195 NAMELIST/namctl/ sn_cfctl, nn_print, nn_ictls, nn_ictle, & 196 & nn_isplt , nn_jsplt, nn_jctls, nn_jctle, & 197 & ln_timing, ln_diacfl 209 NAMELIST/namctl/ sn_cfctl, ln_timing, ln_diacfl, & 210 & nn_isplt, nn_jsplt, nn_ictls, nn_ictle, nn_jctls, nn_jctle 198 211 NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 199 212 !!---------------------------------------------------------------------- 200 213 ! 201 214 cxios_context = 'nemo' 215 nn_hls = 1 202 216 ! 203 217 ! !-------------------------------------------------! … … 292 306 ! 293 307 IF( ln_read_cfg ) THEN ! Read sizes in domain configuration file 294 CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )308 CALL domain_cfg ( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 295 309 ELSE ! user-defined namelist 296 CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )310 CALL usr_def_nam( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 297 311 ENDIF 298 312 ! … … 306 320 CALL mpp_init 307 321 322 CALL halo_mng_init() 308 323 ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 309 324 CALL nemo_alloc() … … 332 347 333 348 CALL sbc_init( Nbb, Nnn, Naa ) ! Forcings : surface module 334 CALL bdy_init ! Open boundaries initialisation 349 CALL bdy_init ! Open boundaries initialisation 350 351 CALL zdf_phy_init( Nnn ) ! Vertical physics 335 352 336 353 ! ! Tracer physics 337 354 CALL ldf_tra_init ! Lateral ocean tracer physics 338 CALL ldf_eiv_init ! Eddy induced velocity param 355 CALL ldf_eiv_init ! Eddy induced velocity param. must be done after ldf_tra_init 339 356 CALL tra_ldf_init ! lateral mixing 340 357 IF( l_ldfslp ) CALL ldf_slp_init ! slope of lateral mixing … … 350 367 CALL dta_dyn_init( Nbb, Nnn, Naa ) ! Initialization for the dynamics 351 368 #endif 352 353 369 CALL trc_init( Nbb, Nnn, Naa ) ! Passive tracers initialization 354 CALL dia_ptr_init ! Poleward TRansports initialization355 370 356 371 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA … … 386 401 WRITE(numout,*) ' sn_cfctl%procincr = ', sn_cfctl%procincr 387 402 WRITE(numout,*) ' sn_cfctl%ptimincr = ', sn_cfctl%ptimincr 388 WRITE(numout,*) ' level of print nn_print = ', nn_print389 WRITE(numout,*) ' Start i indice for SUM control nn_ictls = ', nn_ictls390 WRITE(numout,*) ' End i indice for SUM control nn_ictle = ', nn_ictle391 WRITE(numout,*) ' Start j indice for SUM control nn_jctls = ', nn_jctls392 WRITE(numout,*) ' End j indice for SUM control nn_jctle = ', nn_jctle393 WRITE(numout,*) ' number of proc. following i nn_isplt = ', nn_isplt394 WRITE(numout,*) ' number of proc. following j nn_jsplt = ', nn_jsplt395 403 WRITE(numout,*) ' timing by routine ln_timing = ', ln_timing 396 404 WRITE(numout,*) ' CFL diagnostics ln_diacfl = ', ln_diacfl 397 405 ENDIF 398 ! 399 nprint = nn_print ! convert DOCTOR namelist names into OLD names 400 nictls = nn_ictls 401 nictle = nn_ictle 402 njctls = nn_jctls 403 njctle = nn_jctle 404 isplt = nn_isplt 405 jsplt = nn_jsplt 406 406 407 IF( .NOT.ln_read_cfg ) ln_closea = .false. ! dealing possible only with a domcfg file 407 408 IF(lwp) THEN ! control print 408 409 WRITE(numout,*) … … 414 415 WRITE(numout,*) ' filename to be written cn_domcfg_out = ', TRIM(cn_domcfg_out) 415 416 WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 416 ENDIF417 IF( .NOT.ln_read_cfg ) ln_closea = .false. ! dealing possible only with a domcfg file418 !419 ! ! Parameter control420 !421 IF( sn_cfctl%l_prtctl .OR. sn_cfctl%l_prttrc ) THEN ! sub-domain area indices for the control prints422 IF( lk_mpp .AND. jpnij > 1 ) THEN423 isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj ! the domain is forced to the real split domain424 ELSE425 IF( isplt == 1 .AND. jsplt == 1 ) THEN426 CALL ctl_warn( ' - isplt & jsplt are equal to 1', &427 & ' - the print control will be done over the whole domain' )428 ENDIF429 ijsplt = isplt * jsplt ! total number of processors ijsplt430 ENDIF431 IF(lwp) WRITE(numout,*)' - The total number of processors over which the'432 IF(lwp) WRITE(numout,*)' print control will be done is ijsplt : ', ijsplt433 !434 ! ! indices used for the SUM control435 IF( nictls+nictle+njctls+njctle == 0 ) THEN ! print control done over the default area436 lsp_area = .FALSE.437 ELSE ! print control done over a specific area438 lsp_area = .TRUE.439 IF( nictls < 1 .OR. nictls > jpiglo ) THEN440 CALL ctl_warn( ' - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )441 nictls = 1442 ENDIF443 IF( nictle < 1 .OR. nictle > jpiglo ) THEN444 CALL ctl_warn( ' - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )445 nictle = jpiglo446 ENDIF447 IF( njctls < 1 .OR. njctls > jpjglo ) THEN448 CALL ctl_warn( ' - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )449 njctls = 1450 ENDIF451 IF( njctle < 1 .OR. njctle > jpjglo ) THEN452 CALL ctl_warn( ' - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )453 njctle = jpjglo454 ENDIF455 ENDIF456 417 ENDIF 457 418 !
Note: See TracChangeset
for help on using the changeset viewer.
