- Timestamp:
- 2020-11-02T10:56:42+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves
- Files:
-
- 3 edited
-
. (modified) (1 prop)
-
src/OFF/dtadyn.F90 (modified) (26 diffs)
-
src/OFF/nemogcm.F90 (modified) (25 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 8 9 9 # SETTE 10 ^/utils/CI/sette@ HEADsette10 ^/utils/CI/sette@13559 sette
-
- Property svn:externals
-
NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/src/OFF/dtadyn.F90
r12489 r13710 23 23 USE c1d ! 1D configuration: lk_c1d 24 24 USE dom_oce ! ocean domain: variables 25 #if ! defined key_qco 25 26 USE domvvl ! variable volume 27 #else 28 USE domqco 29 #endif 26 30 USE zdf_oce ! ocean vertical physics: variables 27 31 USE sbc_oce ! surface module: variables … … 52 56 PUBLIC dta_dyn_sed ! called by nemo_gcm 53 57 PUBLIC dta_dyn_atf ! called by nemo_gcm 58 #if ! defined key_qco 54 59 PUBLIC dta_dyn_sf_interp ! called by nemo_gcm 60 #endif 55 61 56 62 CHARACTER(len=100) :: cn_dir !: Root directory for location of ssr files … … 65 71 INTEGER , SAVE :: jf_uwd ! index of u-transport 66 72 INTEGER , SAVE :: jf_vwd ! index of v-transport 67 INTEGER , SAVE :: jf_wwd ! index of v-transport73 INTEGER , SAVE :: jf_wwd ! index of w-transport 68 74 INTEGER , SAVE :: jf_avt ! index of Kz 69 75 INTEGER , SAVE :: jf_mld ! index of mixed layer deptht … … 122 128 ! 123 129 IF( kt == nit000 ) THEN ; nprevrec = 0 124 ELSE ; nprevrec = sf_dyn(jf_tem)%nrec _a(2)130 ELSE ; nprevrec = sf_dyn(jf_tem)%nrec(2,sf_dyn(jf_tem)%naa) 125 131 ENDIF 126 132 CALL fld_read( kt, 1, sf_dyn ) != read data at kt time step ==! … … 149 155 emp_b (:,:) = sf_dyn(jf_empb)%fnow(:,:,1) * tmask(:,:,1) ! E-P 150 156 zemp (:,:) = ( 0.5_wp * ( emp(:,:) + emp_b(:,:) ) + rnf(:,:) + fwbcorr ) * tmask(:,:,1) 151 CALL dta_dyn_ssh( kt, zhdivtr, ssh(:,:,Kbb), zemp, ssh(:,:,Kaa), e3t(:,:,:,Kaa) ) != ssh, vertical scale factor & vertical transport 157 #if defined key_qco 158 CALL dta_dyn_ssh( kt, zhdivtr, ssh(:,:,Kbb), zemp, ssh(:,:,Kaa) ) 159 CALL dom_qco_r3c( ssh(:,:,Kaa), r3t(:,:,Kaa), r3u(:,:,Kaa), r3v(:,:,Kaa) ) 160 #else 161 CALL dta_dyn_ssh( kt, zhdivtr, ssh(:,:,Kbb), zemp, ssh(:,:,Kaa), e3t(:,:,:,Kaa) ) != ssh, vertical scale factor 162 #endif 152 163 DEALLOCATE( zemp , zhdivtr ) 153 164 ! Write in the tracer restart file … … 283 294 ! ! fill sf with slf_i and control print 284 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 285 303 ! 286 304 ! Open file for each variable to get his number of dimension … … 319 337 iom_varid( numrtr, 'sshn', ldstop = .FALSE. ) > 0 ) THEN 320 338 IF(lwp) WRITE(numout,*) ' ssh(:,:,Kmm) forcing fields read in the restart file for initialisation' 321 CALL iom_get( numrtr, jpdom_auto glo, 'sshn', ssh(:,:,Kmm) )322 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) ) 323 341 ELSE 324 342 IF(lwp) WRITE(numout,*) ' ssh(:,:,Kmm) forcing fields read in the restart file for initialisation' 325 343 CALL iom_open( 'restart', inum ) 326 CALL iom_get( inum, jpdom_auto glo, 'sshn', ssh(:,:,Kmm) )327 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) ) 328 346 CALL iom_close( inum ) ! close file 329 347 ENDIF 330 348 ! 349 #if defined key_qco 350 CALL dom_qco_r3c( ssh(:,:,Kbb), r3t(:,:,Kbb), r3u(:,:,Kbb), r3v(:,:,Kbb) ) 351 CALL dom_qco_r3c( ssh(:,:,Kmm), r3t(:,:,Kmm), r3u(:,:,Kmm), r3v(:,:,Kmm) ) 352 #else 331 353 DO jk = 1, jpkm1 332 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( 1._wp + ssh(:,:,Kmm) * tmask(:,:,1) / ( ht_0(:,:) + 1.0 - tmask(:,:,1)) )354 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( 1._wp + ssh(:,:,Kmm) * r1_ht_0(:,:) * tmask(:,:,jk) ) 333 355 ENDDO 334 356 e3t(:,:,jpk,Kaa) = e3t_0(:,:,jpk) … … 342 364 ! ------------------------------------ 343 365 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w(:,:,:,Kmm), 'W' ) 344 366 !!gm this should be computed from ssh(Kbb) 345 367 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 346 368 e3u(:,:,:,Kbb) = e3u(:,:,:,Kmm) … … 352 374 gdepw(:,:,1,Kmm) = 0.0_wp 353 375 354 DO_3D _11_11(2, jpk )376 DO_3D( 1, 1, 1, 1, 2, jpk ) 355 377 ! zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) ! 0 everywhere 356 378 ! tmask = wmask, ie everywhere expect at jk = mikt … … 367 389 ! 368 390 ENDIF 391 #endif 369 392 ! 370 393 IF( ln_dynrnf .AND. ln_dynrnf_depth ) THEN ! read depht over which runoffs are distributed … … 372 395 IF(lwp) WRITE(numout,*) ' read in the file depht over which runoffs are distributed' 373 396 CALL iom_open ( "runoffs", inum ) ! open file 374 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 375 398 CALL iom_close( inum ) ! close file 376 399 ! 377 400 nk_rnf(:,:) = 0 ! set the number of level over which river runoffs are applied 378 DO_2D _11_11401 DO_2D( 1, 1, 1, 1 ) 379 402 IF( h_rnf(ji,jj) > 0._wp ) THEN 380 403 jk = 2 … … 389 412 ENDIF 390 413 END_2D 391 DO_2D _11_11414 DO_2D( 1, 1, 1, 1 ) ! set the associated depth 392 415 h_rnf(ji,jj) = 0._wp 393 416 DO jk = 1, nk_rnf(ji,jj) … … 413 436 END SUBROUTINE dta_dyn_init 414 437 438 415 439 SUBROUTINE dta_dyn_sed( kt, Kmm ) 416 440 !!---------------------------------------------------------------------- … … 434 458 ! 435 459 IF( kt == nit000 ) THEN ; nprevrec = 0 436 ELSE ; nprevrec = sf_dyn(jf_tem)%nrec _a(2)460 ELSE ; nprevrec = sf_dyn(jf_tem)%nrec(2,sf_dyn(jf_tem)%naa) 437 461 ENDIF 438 462 CALL fld_read( kt, 1, sf_dyn ) != read data at kt time step ==! … … 529 553 END SUBROUTINE dta_dyn_sed_init 530 554 555 531 556 SUBROUTINE dta_dyn_atf( kt, Kbb, Kmm, Kaa ) 532 557 !!--------------------------------------------------------------------- … … 552 577 END SUBROUTINE dta_dyn_atf 553 578 579 580 #if ! defined key_qco 554 581 SUBROUTINE dta_dyn_sf_interp( kt, Kmm ) 555 582 !!--------------------------------------------------------------------- … … 580 607 gdepw(:,:,1,Kmm) = 0.0_wp 581 608 ! 582 DO_3D _11_11(2, jpk )609 DO_3D( 1, 1, 1, 1, 2, jpk ) 583 610 zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 584 611 gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) … … 588 615 ! 589 616 END SUBROUTINE dta_dyn_sf_interp 617 #endif 618 590 619 591 620 SUBROUTINE dta_dyn_ssh( kt, phdivtr, psshb, pemp, pssha, pe3ta ) … … 606 635 !! The boundary conditions are w=0 at the bottom (no flux) 607 636 !! 608 !! ** action : ssh(:,:,Kaa) / e3t(:,:, :,Kaa) / ww637 !! ** action : ssh(:,:,Kaa) / e3t(:,:,k,Kaa) / ww 609 638 !! 610 639 !! Reference : Leclair, M., and G. Madec, 2009, Ocean Modelling. … … 630 659 ! ! Sea surface elevation time-stepping 631 660 pssha(:,:) = ( psshb(:,:) - z2dt * ( r1_rho0 * pemp(:,:) + zhdiv(:,:) ) ) * ssmask(:,:) 632 ! !633 !! After acale factors at t-points ( z_star coordinate )661 ! 662 IF( PRESENT( pe3ta ) ) THEN ! After acale factors at t-points ( z_star coordinate ) 634 663 DO jk = 1, jpkm1 635 pe3ta(:,:,jk) = e3t_0(:,:,jk) * ( 1._wp + pssha(:,:) * tmask(:,:,1) / ( ht_0(:,:) + 1.0 - tmask(:,:,1)) )664 pe3ta(:,:,jk) = e3t_0(:,:,jk) * ( 1._wp + pssha(:,:) * r1_ht_0(:,:) * tmask(:,:,jk) ) 636 665 END DO 666 ENDIF 637 667 ! 638 668 END SUBROUTINE dta_dyn_ssh … … 657 687 !!---------------------------------------------------------------------- 658 688 ! 659 DO_2D _11_11689 DO_2D( 1, 1, 1, 1 ) ! update the depth over which runoffs are distributed 660 690 h_rnf(ji,jj) = 0._wp 661 691 DO jk = 1, nk_rnf(ji,jj) ! recalculates h_rnf to be the depth in metres … … 686 716 !!--------------------------------------------------------------------- 687 717 ! 688 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 ! 689 720 IF( kt == nit000 ) THEN 690 721 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.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. 694 725 CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj, Kbb, Kmm ) 695 726 uslpdta (:,:,:,1) = zuslp (:,:,:) … … 698 729 wslpjdta(:,:,:,1) = zwslpj(:,:,:) 699 730 ! 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.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. 703 734 CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj, Kbb, Kmm ) 704 735 uslpdta (:,:,:,2) = zuslp (:,:,:) … … 709 740 ! 710 741 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 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 713 744 IF(lwp) WRITE(numout,*) ' Compute new slopes at kt = ', kt 714 745 uslpdta (:,:,:,1) = uslpdta (:,:,:,2) ! swap the data … … 717 748 wslpjdta(:,:,:,1) = wslpjdta(:,:,:,2) 718 749 ! 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.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. 722 753 CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj, Kbb, Kmm ) 723 754 ! … … 731 762 ! 732 763 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 )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 ) 735 766 ztintb = 1. - ztinta 736 767 IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN ! Computes slopes (here avt is used as workspace) -
NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/src/OFF/nemogcm.F90
r12641 r13710 28 28 USE usrdef_nam ! user defined configuration 29 29 USE eosbn2 ! equation of state (eos bn2 routine) 30 #if defined key_qco 31 USE domqco ! tools for scale factor (dom_qco_r3c routine) 32 #endif 33 USE bdyini ! open boundary cond. setting (bdy_init routine) 30 34 ! ! ocean physics 31 35 USE ldftra ! lateral diffusivity setting (ldf_tra_init routine) … … 36 40 USE sbcmod ! surface boundary condition (sbc_init routine) 37 41 USE phycst ! physical constant (par_cst routine) 42 USE zdfphy ! vertical physics manager (zdf_phy_init routine) 38 43 USE dtadyn ! Lecture and Interpolation of the dynamical fields 39 44 USE trcini ! Initilization of the passive tracers … … 45 50 USE trcnam ! passive tracer : namelist 46 51 USE trcrst ! passive tracer restart 47 USE diaptr ! Need to initialise this as some variables are used in if statements later48 52 USE sbc_oce , ONLY : ln_rnf 49 53 USE sbcrnf ! surface boundary condition : runoffs … … 59 63 USE timing ! Timing 60 64 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 61 USE lbcnfd , ONLY : isendto, nsndto , nfsloop, nfeloop! Setup of north fold exchanges65 USE lbcnfd , ONLY : isendto, nsndto ! Setup of north fold exchanges 62 66 USE step, ONLY : Nbb, Nnn, Naa, Nrhs ! time level indices 67 USE halo_mng 63 68 64 69 IMPLICIT NONE … … 68 73 69 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 70 79 71 80 !!---------------------------------------------------------------------- … … 90 99 !! Madec, 2008, internal report, IPSL. 91 100 !!---------------------------------------------------------------------- 92 INTEGER :: istp, indic ! time step index 101 INTEGER :: istp ! time step index 102 REAL(wp):: zstptiming ! elapsed time for 1 time step 93 103 !!---------------------------------------------------------------------- 94 104 … … 109 119 ! 110 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 111 127 ! 112 128 IF( istp /= nit000 ) CALL day ( istp ) ! Calendar (day was already called at nit000 in day_init) … … 117 133 CALL dta_dyn ( istp, Nbb, Nnn, Naa ) ! Interpolation of the dynamical fields 118 134 #endif 135 #if ! defined key_sed_off 136 IF( .NOT.ln_linssh ) THEN 137 CALL dta_dyn_atf( istp, Nbb, Nnn, Naa ) ! time filter of sea surface height and vertical scale factors 138 # if defined key_qco 139 CALL dom_qco_r3c( ssh(:,:,Kmm), r3t_f, r3u_f, r3v_f ) 140 # endif 141 ENDIF 119 142 CALL trc_stp ( istp, Nbb, Nnn, Nrhs, Naa ) ! time-stepping 120 #if ! defined key_sed_off 121 IF( .NOT.ln_linssh ) CALL dta_dyn_atf( istp, Nbb, Nnn, Naa ) ! time filter of sea surface height and vertical scale factors 143 # if defined key_qco 144 !r3t(:,:,Kmm) = r3t_f(:,:) ! update ssh to h0 ratio 145 !r3u(:,:,Kmm) = r3u_f(:,:) 146 !r3v(:,:,Kmm) = r3v_f(:,:) 147 # endif 122 148 #endif 123 149 ! Swap time levels … … 127 153 Naa = Nrhs 128 154 ! 155 #if ! defined key_qco 129 156 #if ! defined key_sed_off 130 157 IF( .NOT.ln_linssh ) CALL dta_dyn_sf_interp( istp, Nnn ) ! calculate now grid parameters 131 158 #endif 132 CALL stp_ctl ( istp, indic ) ! Time loop: control and print 159 #endif 160 CALL stp_ctl ( istp ) ! Time loop: control and print 133 161 istp = istp + 1 162 163 IF( lwp .AND. ln_timing ) WRITE(numtime,*) 'timing step ', istp-1, ' : ', MPI_Wtime() - zstptiming 164 134 165 END DO 135 166 ! … … 145 176 IF( nstop /= 0 .AND. lwp ) THEN ! error print 146 177 WRITE(ctmp1,*) ' ==>>> nemo_gcm: a total of ', nstop, ' errors have been found' 147 CALL ctl_stop( ctmp1 ) 178 WRITE(ctmp2,*) ' Look for "E R R O R" messages in all existing ocean_output* files' 179 CALL ctl_stop( ' ', ctmp1, ' ', ctmp2 ) 148 180 ENDIF 149 181 ! … … 175 207 INTEGER :: ios, ilocal_comm ! local integers 176 208 !! 177 NAMELIST/namctl/ sn_cfctl, nn_print, nn_ictls, nn_ictle, & 178 & nn_isplt , nn_jsplt, nn_jctls, nn_jctle, & 179 & 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 180 211 NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 181 212 !!---------------------------------------------------------------------- 182 213 ! 183 214 cxios_context = 'nemo' 215 nn_hls = 1 184 216 ! 185 217 ! !-------------------------------------------------! … … 227 259 ! 228 260 ! finalize the definition of namctl variables 229 IF( sn_cfctl%l_allon ) THEN 230 ! Turn on all options. 231 CALL nemo_set_cfctl( sn_cfctl, .TRUE., .TRUE. ) 232 ! Ensure all processors are active 233 sn_cfctl%procmin = 0 ; sn_cfctl%procmax = 1000000 ; sn_cfctl%procincr = 1 234 ELSEIF( sn_cfctl%l_config ) THEN 235 ! Activate finer control of report outputs 236 ! optionally switch off output from selected areas (note this only 237 ! applies to output which does not involve global communications) 238 IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax ) .OR. & 239 & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) ) & 240 & CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 241 ELSE 242 ! turn off all options. 243 CALL nemo_set_cfctl( sn_cfctl, .FALSE., .TRUE. ) 244 ENDIF 261 IF( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax .OR. MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) & 262 & CALL nemo_set_cfctl( sn_cfctl, .FALSE. ) 245 263 ! 246 264 lwp = (narea == 1) .OR. sn_cfctl%l_oceout ! control of all listing output print … … 288 306 ! 289 307 IF( ln_read_cfg ) THEN ! Read sizes in domain configuration file 290 CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )308 CALL domain_cfg ( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 291 309 ELSE ! user-defined namelist 292 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 ) 293 311 ENDIF 294 312 ! … … 302 320 CALL mpp_init 303 321 322 CALL halo_mng_init() 304 323 ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 305 324 CALL nemo_alloc() … … 307 326 ! Initialise time level indices 308 327 Nbb = 1; Nnn = 2; Naa = 3; Nrhs = Naa 309 310 328 311 329 ! !-------------------------------! … … 329 347 330 348 CALL sbc_init( Nbb, Nnn, Naa ) ! Forcings : surface module 349 CALL bdy_init ! Open boundaries initialisation 350 351 CALL zdf_phy_init( Nnn ) ! Vertical physics 331 352 332 353 ! ! Tracer physics 333 354 CALL ldf_tra_init ! Lateral ocean tracer physics 334 CALL ldf_eiv_init ! Eddy induced velocity param 355 CALL ldf_eiv_init ! Eddy induced velocity param. must be done after ldf_tra_init 335 356 CALL tra_ldf_init ! lateral mixing 336 357 IF( l_ldfslp ) CALL ldf_slp_init ! slope of lateral mixing … … 346 367 CALL dta_dyn_init( Nbb, Nnn, Naa ) ! Initialization for the dynamics 347 368 #endif 348 349 369 CALL trc_init( Nbb, Nnn, Naa ) ! Passive tracers initialization 350 CALL dia_ptr_init ! Poleward TRansports initialization351 370 352 371 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA … … 371 390 WRITE(numout,*) '~~~~~~~~' 372 391 WRITE(numout,*) ' Namelist namctl' 373 WRITE(numout,*) ' sn_cfctl%l_glochk = ', sn_cfctl%l_glochk374 WRITE(numout,*) ' sn_cfctl%l_allon = ', sn_cfctl%l_allon375 WRITE(numout,*) ' finer control over o/p sn_cfctl%l_config = ', sn_cfctl%l_config376 392 WRITE(numout,*) ' sn_cfctl%l_runstat = ', sn_cfctl%l_runstat 377 393 WRITE(numout,*) ' sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat … … 385 401 WRITE(numout,*) ' sn_cfctl%procincr = ', sn_cfctl%procincr 386 402 WRITE(numout,*) ' sn_cfctl%ptimincr = ', sn_cfctl%ptimincr 387 WRITE(numout,*) ' level of print nn_print = ', nn_print388 WRITE(numout,*) ' Start i indice for SUM control nn_ictls = ', nn_ictls389 WRITE(numout,*) ' End i indice for SUM control nn_ictle = ', nn_ictle390 WRITE(numout,*) ' Start j indice for SUM control nn_jctls = ', nn_jctls391 WRITE(numout,*) ' End j indice for SUM control nn_jctle = ', nn_jctle392 WRITE(numout,*) ' number of proc. following i nn_isplt = ', nn_isplt393 WRITE(numout,*) ' number of proc. following j nn_jsplt = ', nn_jsplt394 403 WRITE(numout,*) ' timing by routine ln_timing = ', ln_timing 395 404 WRITE(numout,*) ' CFL diagnostics ln_diacfl = ', ln_diacfl 396 405 ENDIF 397 ! 398 nprint = nn_print ! convert DOCTOR namelist names into OLD names 399 nictls = nn_ictls 400 nictle = nn_ictle 401 njctls = nn_jctls 402 njctle = nn_jctle 403 isplt = nn_isplt 404 jsplt = nn_jsplt 405 406 407 IF( .NOT.ln_read_cfg ) ln_closea = .false. ! dealing possible only with a domcfg file 406 408 IF(lwp) THEN ! control print 407 409 WRITE(numout,*) … … 414 416 WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 415 417 ENDIF 416 IF( .NOT.ln_read_cfg ) ln_closea = .false. ! dealing possible only with a domcfg file417 !418 ! ! Parameter control419 !420 IF( sn_cfctl%l_prtctl .OR. sn_cfctl%l_prttrc ) THEN ! sub-domain area indices for the control prints421 IF( lk_mpp .AND. jpnij > 1 ) THEN422 isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj ! the domain is forced to the real split domain423 ELSE424 IF( isplt == 1 .AND. jsplt == 1 ) THEN425 CALL ctl_warn( ' - isplt & jsplt are equal to 1', &426 & ' - the print control will be done over the whole domain' )427 ENDIF428 ijsplt = isplt * jsplt ! total number of processors ijsplt429 ENDIF430 IF(lwp) WRITE(numout,*)' - The total number of processors over which the'431 IF(lwp) WRITE(numout,*)' print control will be done is ijsplt : ', ijsplt432 !433 ! ! indices used for the SUM control434 IF( nictls+nictle+njctls+njctle == 0 ) THEN ! print control done over the default area435 lsp_area = .FALSE.436 ELSE ! print control done over a specific area437 lsp_area = .TRUE.438 IF( nictls < 1 .OR. nictls > jpiglo ) THEN439 CALL ctl_warn( ' - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )440 nictls = 1441 ENDIF442 IF( nictle < 1 .OR. nictle > jpiglo ) THEN443 CALL ctl_warn( ' - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )444 nictle = jpiglo445 ENDIF446 IF( njctls < 1 .OR. njctls > jpjglo ) THEN447 CALL ctl_warn( ' - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )448 njctls = 1449 ENDIF450 IF( njctle < 1 .OR. njctle > jpjglo ) THEN451 CALL ctl_warn( ' - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )452 njctle = jpjglo453 ENDIF454 ENDIF455 ENDIF456 418 ! 457 419 IF( 1._wp /= SIGN(1._wp,-0._wp) ) CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.', & … … 492 454 USE zdf_oce, ONLY : zdf_oce_alloc 493 455 USE trc_oce, ONLY : trc_oce_alloc 456 USE bdy_oce, ONLY : bdy_oce_alloc 494 457 ! 495 458 INTEGER :: ierr … … 501 464 ierr = ierr + zdf_oce_alloc() ! ocean vertical physics 502 465 ierr = ierr + trc_oce_alloc() ! shared TRC / TRA arrays 466 ierr = ierr + bdy_oce_alloc() ! bdy masks (incl. initialization) 503 467 ! 504 468 CALL mpp_sum( 'nemogcm', ierr ) … … 507 471 END SUBROUTINE nemo_alloc 508 472 509 SUBROUTINE nemo_set_cfctl(sn_cfctl, setto , for_all)473 SUBROUTINE nemo_set_cfctl(sn_cfctl, setto ) 510 474 !!---------------------------------------------------------------------- 511 475 !! *** ROUTINE nemo_set_cfctl *** 512 476 !! 513 477 !! ** Purpose : Set elements of the output control structure to setto. 514 !! for_all should be .false. unless all areas are to be 515 !! treated identically. 516 !! 478 !! 517 479 !! ** Method : Note this routine can be used to switch on/off some 518 !! types of output for selected areas but any output types 519 !! that involve global communications (e.g. mpp_max, glob_sum) 520 !! should be protected from selective switching by the 521 !! for_all argument 522 !!---------------------------------------------------------------------- 523 LOGICAL :: setto, for_all 524 TYPE(sn_ctl) :: sn_cfctl 525 !!---------------------------------------------------------------------- 526 IF( for_all ) THEN 527 sn_cfctl%l_runstat = setto 528 sn_cfctl%l_trcstat = setto 529 ENDIF 480 !! types of output for selected areas. 481 !!---------------------------------------------------------------------- 482 TYPE(sn_ctl), INTENT(inout) :: sn_cfctl 483 LOGICAL , INTENT(in ) :: setto 484 !!---------------------------------------------------------------------- 485 sn_cfctl%l_runstat = setto 486 sn_cfctl%l_trcstat = setto 530 487 sn_cfctl%l_oceout = setto 531 488 sn_cfctl%l_layout = setto … … 557 514 558 515 559 SUBROUTINE stp_ctl( kt , kindic)516 SUBROUTINE stp_ctl( kt ) 560 517 !!---------------------------------------------------------------------- 561 518 !! *** ROUTINE stp_ctl *** … … 568 525 !!---------------------------------------------------------------------- 569 526 INTEGER, INTENT(in ) :: kt ! ocean time-step index 570 INTEGER, INTENT(inout) :: kindic ! indicator of solver convergence571 527 !!---------------------------------------------------------------------- 572 528 !
Note: See TracChangeset
for help on using the changeset viewer.
