- Timestamp:
- 2020-09-29T12:41:06+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/r12377_ticket2386
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OFF/nemogcm.F90 (modified) (21 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/r12377_ticket2386
- 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@13507 sette
-
- Property svn:externals
-
NEMO/branches/2020/r12377_ticket2386/src/OFF/nemogcm.F90
r12377 r13540 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) … … 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 … … 90 95 !! Madec, 2008, internal report, IPSL. 91 96 !!---------------------------------------------------------------------- 92 INTEGER :: istp , indic! time step index97 INTEGER :: istp ! time step index 93 98 !!---------------------------------------------------------------------- 94 99 … … 117 122 CALL dta_dyn ( istp, Nbb, Nnn, Naa ) ! Interpolation of the dynamical fields 118 123 #endif 124 #if ! defined key_sed_off 125 IF( .NOT.ln_linssh ) THEN 126 CALL dta_dyn_atf( istp, Nbb, Nnn, Naa ) ! time filter of sea surface height and vertical scale factors 127 # if defined key_qco 128 CALL dom_qco_r3c( ssh(:,:,Kmm), r3t_f, r3u_f, r3v_f ) 129 # endif 130 ENDIF 119 131 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 132 # if defined key_qco 133 !r3t(:,:,Kmm) = r3t_f(:,:) ! update ssh to h0 ratio 134 !r3u(:,:,Kmm) = r3u_f(:,:) 135 !r3v(:,:,Kmm) = r3v_f(:,:) 136 # endif 122 137 #endif 123 138 ! Swap time levels … … 127 142 Naa = Nrhs 128 143 ! 144 #if ! defined key_qco 129 145 #if ! defined key_sed_off 130 146 IF( .NOT.ln_linssh ) CALL dta_dyn_sf_interp( istp, Nnn ) ! calculate now grid parameters 131 147 #endif 132 CALL stp_ctl ( istp, indic ) ! Time loop: control and print 148 #endif 149 CALL stp_ctl ( istp ) ! Time loop: control and print 133 150 istp = istp + 1 134 151 END DO … … 145 162 IF( nstop /= 0 .AND. lwp ) THEN ! error print 146 163 WRITE(ctmp1,*) ' ==>>> nemo_gcm: a total of ', nstop, ' errors have been found' 147 CALL ctl_stop( ctmp1 ) 164 WRITE(ctmp2,*) ' Look for "E R R O R" messages in all existing ocean_output* files' 165 CALL ctl_stop( ' ', ctmp1, ' ', ctmp2 ) 148 166 ENDIF 149 167 ! … … 175 193 INTEGER :: ios, ilocal_comm ! local integers 176 194 !! 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 195 NAMELIST/namctl/ sn_cfctl, ln_timing, ln_diacfl, & 196 & nn_isplt, nn_jsplt, nn_ictls, nn_ictle, nn_jctls, nn_jctle 180 197 NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 181 198 !!---------------------------------------------------------------------- 182 199 ! 183 200 cxios_context = 'nemo' 201 nn_hls = 1 184 202 ! 185 203 ! !-------------------------------------------------! … … 209 227 IF( lwm ) CALL ctl_opn( numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 210 228 ! open /dev/null file to be able to supress output write easily 229 IF( Agrif_Root() ) THEN 211 230 CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 231 #ifdef key_agrif 232 ELSE 233 numnul = Agrif_Parent(numnul) 234 #endif 235 ENDIF 212 236 ! 213 237 ! !--------------------! … … 221 245 ! 222 246 ! finalize the definition of namctl variables 223 IF( sn_cfctl%l_allon ) THEN 224 ! Turn on all options. 225 CALL nemo_set_cfctl( sn_cfctl, .TRUE., .TRUE. ) 226 ! Ensure all processors are active 227 sn_cfctl%procmin = 0 ; sn_cfctl%procmax = 1000000 ; sn_cfctl%procincr = 1 228 ELSEIF( sn_cfctl%l_config ) THEN 229 ! Activate finer control of report outputs 230 ! optionally switch off output from selected areas (note this only 231 ! applies to output which does not involve global communications) 232 IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax ) .OR. & 233 & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) ) & 234 & CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 235 ELSE 236 ! turn off all options. 237 CALL nemo_set_cfctl( sn_cfctl, .FALSE., .TRUE. ) 238 ENDIF 247 IF( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax .OR. MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) & 248 & CALL nemo_set_cfctl( sn_cfctl, .FALSE. ) 239 249 ! 240 250 lwp = (narea == 1) .OR. sn_cfctl%l_oceout ! control of all listing output print … … 282 292 ! 283 293 IF( ln_read_cfg ) THEN ! Read sizes in domain configuration file 284 CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )294 CALL domain_cfg ( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 285 295 ELSE ! user-defined namelist 286 CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )296 CALL usr_def_nam( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 287 297 ENDIF 288 298 ! … … 296 306 CALL mpp_init 297 307 308 CALL halo_mng_init() 298 309 ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 299 310 CALL nemo_alloc() … … 301 312 ! Initialise time level indices 302 313 Nbb = 1; Nnn = 2; Naa = 3; Nrhs = Naa 303 304 314 305 315 ! !-------------------------------! … … 323 333 324 334 CALL sbc_init( Nbb, Nnn, Naa ) ! Forcings : surface module 335 CALL bdy_init ! Open boundaries initialisation 325 336 326 337 ! ! Tracer physics … … 365 376 WRITE(numout,*) '~~~~~~~~' 366 377 WRITE(numout,*) ' Namelist namctl' 367 WRITE(numout,*) ' sn_cfctl%l_glochk = ', sn_cfctl%l_glochk368 WRITE(numout,*) ' sn_cfctl%l_allon = ', sn_cfctl%l_allon369 WRITE(numout,*) ' finer control over o/p sn_cfctl%l_config = ', sn_cfctl%l_config370 378 WRITE(numout,*) ' sn_cfctl%l_runstat = ', sn_cfctl%l_runstat 371 379 WRITE(numout,*) ' sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat … … 379 387 WRITE(numout,*) ' sn_cfctl%procincr = ', sn_cfctl%procincr 380 388 WRITE(numout,*) ' sn_cfctl%ptimincr = ', sn_cfctl%ptimincr 381 WRITE(numout,*) ' level of print nn_print = ', nn_print382 WRITE(numout,*) ' Start i indice for SUM control nn_ictls = ', nn_ictls383 WRITE(numout,*) ' End i indice for SUM control nn_ictle = ', nn_ictle384 WRITE(numout,*) ' Start j indice for SUM control nn_jctls = ', nn_jctls385 WRITE(numout,*) ' End j indice for SUM control nn_jctle = ', nn_jctle386 WRITE(numout,*) ' number of proc. following i nn_isplt = ', nn_isplt387 WRITE(numout,*) ' number of proc. following j nn_jsplt = ', nn_jsplt388 389 WRITE(numout,*) ' timing by routine ln_timing = ', ln_timing 389 390 WRITE(numout,*) ' CFL diagnostics ln_diacfl = ', ln_diacfl 390 391 ENDIF 391 ! 392 nprint = nn_print ! convert DOCTOR namelist names into OLD names 393 nictls = nn_ictls 394 nictle = nn_ictle 395 njctls = nn_jctls 396 njctle = nn_jctle 397 isplt = nn_isplt 398 jsplt = nn_jsplt 399 392 393 IF( .NOT.ln_read_cfg ) ln_closea = .false. ! dealing possible only with a domcfg file 400 394 IF(lwp) THEN ! control print 401 395 WRITE(numout,*) … … 408 402 WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 409 403 ENDIF 410 IF( .NOT.ln_read_cfg ) ln_closea = .false. ! dealing possible only with a domcfg file411 !412 ! ! Parameter control413 !414 IF( sn_cfctl%l_prtctl .OR. sn_cfctl%l_prttrc ) THEN ! sub-domain area indices for the control prints415 IF( lk_mpp .AND. jpnij > 1 ) THEN416 isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj ! the domain is forced to the real split domain417 ELSE418 IF( isplt == 1 .AND. jsplt == 1 ) THEN419 CALL ctl_warn( ' - isplt & jsplt are equal to 1', &420 & ' - the print control will be done over the whole domain' )421 ENDIF422 ijsplt = isplt * jsplt ! total number of processors ijsplt423 ENDIF424 IF(lwp) WRITE(numout,*)' - The total number of processors over which the'425 IF(lwp) WRITE(numout,*)' print control will be done is ijsplt : ', ijsplt426 !427 ! ! indices used for the SUM control428 IF( nictls+nictle+njctls+njctle == 0 ) THEN ! print control done over the default area429 lsp_area = .FALSE.430 ELSE ! print control done over a specific area431 lsp_area = .TRUE.432 IF( nictls < 1 .OR. nictls > jpiglo ) THEN433 CALL ctl_warn( ' - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )434 nictls = 1435 ENDIF436 IF( nictle < 1 .OR. nictle > jpiglo ) THEN437 CALL ctl_warn( ' - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )438 nictle = jpiglo439 ENDIF440 IF( njctls < 1 .OR. njctls > jpjglo ) THEN441 CALL ctl_warn( ' - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )442 njctls = 1443 ENDIF444 IF( njctle < 1 .OR. njctle > jpjglo ) THEN445 CALL ctl_warn( ' - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )446 njctle = jpjglo447 ENDIF448 ENDIF449 ENDIF450 404 ! 451 405 IF( 1._wp /= SIGN(1._wp,-0._wp) ) CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.', & … … 486 440 USE zdf_oce, ONLY : zdf_oce_alloc 487 441 USE trc_oce, ONLY : trc_oce_alloc 442 USE bdy_oce, ONLY : bdy_oce_alloc 488 443 ! 489 444 INTEGER :: ierr … … 495 450 ierr = ierr + zdf_oce_alloc() ! ocean vertical physics 496 451 ierr = ierr + trc_oce_alloc() ! shared TRC / TRA arrays 452 ierr = ierr + bdy_oce_alloc() ! bdy masks (incl. initialization) 497 453 ! 498 454 CALL mpp_sum( 'nemogcm', ierr ) … … 501 457 END SUBROUTINE nemo_alloc 502 458 503 SUBROUTINE nemo_set_cfctl(sn_cfctl, setto , for_all)459 SUBROUTINE nemo_set_cfctl(sn_cfctl, setto ) 504 460 !!---------------------------------------------------------------------- 505 461 !! *** ROUTINE nemo_set_cfctl *** 506 462 !! 507 463 !! ** Purpose : Set elements of the output control structure to setto. 508 !! for_all should be .false. unless all areas are to be 509 !! treated identically. 510 !! 464 !! 511 465 !! ** Method : Note this routine can be used to switch on/off some 512 !! types of output for selected areas but any output types 513 !! that involve global communications (e.g. mpp_max, glob_sum) 514 !! should be protected from selective switching by the 515 !! for_all argument 516 !!---------------------------------------------------------------------- 517 LOGICAL :: setto, for_all 518 TYPE(sn_ctl) :: sn_cfctl 519 !!---------------------------------------------------------------------- 520 IF( for_all ) THEN 521 sn_cfctl%l_runstat = setto 522 sn_cfctl%l_trcstat = setto 523 ENDIF 466 !! types of output for selected areas. 467 !!---------------------------------------------------------------------- 468 TYPE(sn_ctl), INTENT(inout) :: sn_cfctl 469 LOGICAL , INTENT(in ) :: setto 470 !!---------------------------------------------------------------------- 471 sn_cfctl%l_runstat = setto 472 sn_cfctl%l_trcstat = setto 524 473 sn_cfctl%l_oceout = setto 525 474 sn_cfctl%l_layout = setto … … 551 500 552 501 553 SUBROUTINE stp_ctl( kt , kindic)502 SUBROUTINE stp_ctl( kt ) 554 503 !!---------------------------------------------------------------------- 555 504 !! *** ROUTINE stp_ctl *** … … 562 511 !!---------------------------------------------------------------------- 563 512 INTEGER, INTENT(in ) :: kt ! ocean time-step index 564 INTEGER, INTENT(inout) :: kindic ! indicator of solver convergence565 513 !!---------------------------------------------------------------------- 566 514 !
Note: See TracChangeset
for help on using the changeset viewer.
