Changeset 13766 for NEMO/branches/2020/dev_12905_xios_ancil/src/SAS
- Timestamp:
- 2020-11-10T12:57:08+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_12905_xios_ancil
- Files:
-
- 6 edited
-
. (modified) (1 prop)
-
src/SAS/diawri.F90 (modified) (2 diffs)
-
src/SAS/nemogcm.F90 (modified) (22 diffs)
-
src/SAS/sbcssm.F90 (modified) (2 diffs)
-
src/SAS/step.F90 (modified) (5 diffs)
-
src/SAS/stpctl.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_12905_xios_ancil
- 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_12905_xios_ancil/src/SAS/diawri.F90
r12649 r13766 138 138 !! Each nn_write time step, output the instantaneous or mean fields 139 139 !!---------------------------------------------------------------------- 140 !!141 140 INTEGER, INTENT( in ) :: kt ! ocean time-step index 142 INTEGER, INTENT( in ) :: Kmm ! ocean time level index141 INTEGER, INTENT( in ) :: Kmm ! ocean time level index 143 142 !! 144 143 LOGICAL :: ll_print = .FALSE. ! =T print and flush numout … … 462 461 CALL iom_close( inum ) 463 462 ENDIF 464 #endif 465 463 ! 464 #endif 466 465 END SUBROUTINE dia_wri_state 467 466 -
NEMO/branches/2020/dev_12905_xios_ancil/src/SAS/nemogcm.F90
r13040 r13766 2 2 !!====================================================================== 3 3 !! *** MODULE nemogcm *** 4 !! StandAlone Surface module : surface fluxes + sea-ice + iceberg floats 4 !! StandAlone Surface module : surface fluxes + sea-ice + iceberg floats + ABL 5 5 !!====================================================================== 6 6 !! History : 3.6 ! 2011-11 (S. Alderson, G. Madec) original code … … 35 35 USE step_diu ! diurnal bulk SST timestepping (called from here if run offline) 36 36 ! 37 USE prtctl ! Print control 37 38 USE in_out_manager ! I/O manager 38 39 USE lib_mpp ! distributed memory computing 39 40 USE mppini ! shared/distributed memory setting (mpp_init routine) 40 USE lbcnfd , ONLY : isendto, nsndto , nfsloop, nfeloop! Setup of north fold exchanges41 USE lbcnfd , ONLY : isendto, nsndto ! Setup of north fold exchanges 41 42 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 42 43 #if defined key_iomput … … 46 47 USE agrif_ice_update ! ice update 47 48 #endif 49 USE halo_mng 48 50 49 51 IMPLICIT NONE … … 56 58 57 59 #if defined key_mpp_mpi 60 ! need MPI_Wtime 58 61 INCLUDE 'mpif.h' 59 62 #endif … … 81 84 !!---------------------------------------------------------------------- 82 85 INTEGER :: istp ! time step index 86 REAL(wp):: zstptiming ! elapsed time for 1 time step 83 87 !!---------------------------------------------------------------------- 84 88 ! … … 91 95 #if defined key_agrif 92 96 Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs ! agrif_oce module copies of time level indices 93 CALL Agrif_Declare_Var_dom ! AGRIF: set the meshes for DOM 94 CALL Agrif_Declare_Var ! " " " " " DYN/TRA 97 CALL Agrif_Declare_Var ! " " " " " DYN/TRA 95 98 # if defined key_top 96 99 CALL Agrif_Declare_Var_top ! " " " " " TOP 97 100 # endif 98 # if defined key_si399 CALL Agrif_Declare_Var_ice ! " " " " " Sea ice100 # endif101 101 #endif 102 102 ! check that all process are still there... If some process have an error, … … 109 109 ! !== time stepping ==! 110 110 ! !-----------------------! 111 ! 112 ! !== set the model time-step ==! 113 ! 111 114 istp = nit000 112 115 ! … … 126 129 END DO 127 130 ! 128 IF( .NOT. Agrif_Root() ) THEN 129 CALL Agrif_ParentGrid_To_ChildGrid() 130 IF( ln_timing ) CALL timing_finalize 131 CALL Agrif_ChildGrid_To_ParentGrid() 132 ENDIF 133 ! 134 #else 131 # else 135 132 ! 136 133 IF( .NOT.ln_diurnal_only ) THEN !== Standard time-stepping ==! 137 134 ! 138 135 DO WHILE( istp <= nitend .AND. nstop == 0 ) 139 #if defined key_mpp_mpi 136 140 137 ncom_stp = istp 141 IF ( istp == ( nit000 + 1 ) ) elapsed_time = MPI_Wtime() 142 IF ( istp == nitend ) elapsed_time = MPI_Wtime() - elapsed_time 143 #endif 138 IF( ln_timing ) THEN 139 zstptiming = MPI_Wtime() 140 IF ( istp == ( nit000 + 1 ) ) elapsed_time = zstptiming 141 IF ( istp == nitend ) elapsed_time = zstptiming - elapsed_time 142 ENDIF 143 144 144 CALL stp ( istp ) 145 145 istp = istp + 1 146 147 IF( lwp .AND. ln_timing ) WRITE(numtime,*) 'timing step ', istp-1, ' : ', MPI_Wtime() - zstptiming 148 146 149 END DO 147 150 ! … … 166 169 IF( nstop /= 0 .AND. lwp ) THEN ! error print 167 170 WRITE(ctmp1,*) ' ==>>> nemo_gcm: a total of ', nstop, ' errors have been found' 168 CALL ctl_stop( ctmp1 ) 171 IF( ngrdstop > 0 ) THEN 172 WRITE(ctmp9,'(i2)') ngrdstop 173 WRITE(ctmp2,*) ' E R R O R detected in Agrif grid '//TRIM(ctmp9) 174 WRITE(ctmp3,*) ' Look for "E R R O R" messages in all existing '//TRIM(ctmp9)//'_ocean_output* files' 175 CALL ctl_stop( ' ', ctmp1, ' ', ctmp2, ' ', ctmp3 ) 176 ELSE 177 WRITE(ctmp2,*) ' Look for "E R R O R" messages in all existing ocean_output* files' 178 CALL ctl_stop( ' ', ctmp1, ' ', ctmp2 ) 179 ENDIF 169 180 ENDIF 170 181 ! … … 199 210 INTEGER :: ios, ilocal_comm ! local integers 200 211 !! 201 NAMELIST/namctl/ sn_cfctl, nn_print, nn_ictls, nn_ictle, & 202 & nn_isplt , nn_jsplt, nn_jctls, nn_jctle, & 203 & ln_timing, ln_diacfl 212 NAMELIST/namctl/ sn_cfctl, ln_timing, ln_diacfl, & 213 & nn_isplt, nn_jsplt, nn_ictls, nn_ictle, nn_jctls, nn_jctle 204 214 NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr, ln_xios_cfg 205 215 !!---------------------------------------------------------------------- … … 208 218 ELSE ; cxios_context = 'nemo' 209 219 ENDIF 220 nn_hls = 1 210 221 ! 211 222 ! !-------------------------------------------------! … … 275 286 ! 276 287 ! finalize the definition of namctl variables 277 IF( sn_cfctl%l_allon ) THEN 278 ! Turn on all options. 279 CALL nemo_set_cfctl( sn_cfctl, .TRUE., .TRUE. ) 280 ! Ensure all processors are active 281 sn_cfctl%procmin = 0 ; sn_cfctl%procmax = 1000000 ; sn_cfctl%procincr = 1 282 ELSEIF( sn_cfctl%l_config ) THEN 283 ! Activate finer control of report outputs 284 ! optionally switch off output from selected areas (note this only 285 ! applies to output which does not involve global communications) 286 IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax ) .OR. & 287 & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) ) & 288 & CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 289 ELSE 290 ! turn off all options. 291 CALL nemo_set_cfctl( sn_cfctl, .FALSE., .TRUE. ) 292 ENDIF 288 IF( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax .OR. MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) & 289 & CALL nemo_set_cfctl( sn_cfctl, .FALSE. ) 293 290 ! 294 291 lwp = (narea == 1) .OR. sn_cfctl%l_oceout ! control of all listing output print … … 319 316 WRITE(numout,*) " ) ) \) |`\ \) '. \ ( ( " 320 317 WRITE(numout,*) " ( ( \_/ '-._\ ) ) " 321 WRITE(numout,*) " ) ) jgs `( ( "318 WRITE(numout,*) " ) ) jgs ` ( ( " 322 319 WRITE(numout,*) " ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ " 323 320 WRITE(numout,*) … … 340 337 ! 341 338 IF( ln_read_cfg ) THEN ! Read sizes in domain configuration file 342 CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )339 CALL domain_cfg ( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 343 340 ELSE ! user-defined namelist 344 CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )341 CALL usr_def_nam( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 345 342 ENDIF 346 343 ! … … 352 349 CALL mpp_init 353 350 351 CALL halo_mng_init() 354 352 ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 355 353 CALL nemo_alloc() … … 357 355 ! Initialise time level indices 358 356 Nbb = 1; Nnn = 2; Naa = 3; Nrhs = Naa 357 #if defined key_agrif 358 Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs ! agrif_oce module copies of time level indices 359 #endif 359 360 360 361 ! !-------------------------------! … … 365 366 ! 366 367 ! ! General initialization 367 IF( ln_timing ) CALL timing_init ! timing368 IF( ln_timing ) CALL timing_init ( 'timing_sas.output' ) 368 369 IF( ln_timing ) CALL timing_start( 'nemo_init') 369 370 370 371 CALL phy_cst ! Physical constants 371 372 CALL eos_init ! Equation of seawater 373 #if defined key_agrif 374 CALL Agrif_Declare_Var_ini ! " " " " " DOM 375 #endif 372 376 CALL dom_init( Nbb, Nnn, Naa, 'SAS') ! Domain 373 377 IF( sn_cfctl%l_prtctl ) & 374 378 & CALL prt_ctl_init ! Print control 375 379 380 IF( ln_rstart ) CALL rst_read_open 376 381 CALL day_init ! model calendar (using both namelist and restart infos) 377 IF( ln_rstart ) CALL rst_read_open 378 382 383 #if defined key_agrif 384 uu(:,:,:,:) = 0.0_wp ; vv(:,:,:,:) = 0.0_wp ; ts(:,:,:,:,:) = 0.0_wp ! needed for interp done at initialization phase 385 #endif 379 386 ! ! external forcing 380 387 CALL sbc_init( Nbb, Nnn, Naa ) ! Forcings : surface module … … 408 415 WRITE(numout,*) '~~~~~~~~' 409 416 WRITE(numout,*) ' Namelist namctl' 410 WRITE(numout,*) ' sn_cfctl%l_glochk = ', sn_cfctl%l_glochk411 WRITE(numout,*) ' sn_cfctl%l_allon = ', sn_cfctl%l_allon412 WRITE(numout,*) ' finer control over o/p sn_cfctl%l_config = ', sn_cfctl%l_config413 417 WRITE(numout,*) ' sn_cfctl%l_runstat = ', sn_cfctl%l_runstat 414 418 WRITE(numout,*) ' sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat … … 422 426 WRITE(numout,*) ' sn_cfctl%procincr = ', sn_cfctl%procincr 423 427 WRITE(numout,*) ' sn_cfctl%ptimincr = ', sn_cfctl%ptimincr 424 WRITE(numout,*) ' level of print nn_print = ', nn_print425 WRITE(numout,*) ' Start i indice for SUM control nn_ictls = ', nn_ictls426 WRITE(numout,*) ' End i indice for SUM control nn_ictle = ', nn_ictle427 WRITE(numout,*) ' Start j indice for SUM control nn_jctls = ', nn_jctls428 WRITE(numout,*) ' End j indice for SUM control nn_jctle = ', nn_jctle429 WRITE(numout,*) ' number of proc. following i nn_isplt = ', nn_isplt430 WRITE(numout,*) ' number of proc. following j nn_jsplt = ', nn_jsplt431 428 WRITE(numout,*) ' timing by routine ln_timing = ', ln_timing 432 429 WRITE(numout,*) ' CFL diagnostics ln_diacfl = ', ln_diacfl 433 430 ENDIF 434 431 ! 435 nprint = nn_print ! convert DOCTOR namelist names into OLD names 436 nictls = nn_ictls 437 nictle = nn_ictle 438 njctls = nn_jctls 439 njctle = nn_jctle 440 isplt = nn_isplt 441 jsplt = nn_jsplt 442 432 IF( .NOT.ln_read_cfg ) ln_closea = .FALSE. ! dealing possible only with a domcfg file 443 433 IF(lwp) THEN ! control print 444 434 WRITE(numout,*) … … 451 441 WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 452 442 ENDIF 453 IF( .NOT.ln_read_cfg ) ln_closea = .false. ! dealing possible only with a domcfg file454 !455 ! ! Parameter control456 !457 IF( sn_cfctl%l_prtctl .OR. sn_cfctl%l_prttrc ) THEN ! sub-domain area indices for the control prints458 IF( lk_mpp .AND. jpnij > 1 ) THEN459 isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj ! the domain is forced to the real split domain460 ELSE461 IF( isplt == 1 .AND. jsplt == 1 ) THEN462 CALL ctl_warn( ' - isplt & jsplt are equal to 1', &463 & ' - the print control will be done over the whole domain' )464 ENDIF465 ijsplt = isplt * jsplt ! total number of processors ijsplt466 ENDIF467 IF(lwp) WRITE(numout,*)' - The total number of processors over which the'468 IF(lwp) WRITE(numout,*)' print control will be done is ijsplt : ', ijsplt469 !470 ! ! indices used for the SUM control471 IF( nictls+nictle+njctls+njctle == 0 ) THEN ! print control done over the default area472 lsp_area = .FALSE.473 ELSE ! print control done over a specific area474 lsp_area = .TRUE.475 IF( nictls < 1 .OR. nictls > jpiglo ) THEN476 CALL ctl_warn( ' - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )477 nictls = 1478 ENDIF479 IF( nictle < 1 .OR. nictle > jpiglo ) THEN480 CALL ctl_warn( ' - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )481 nictle = jpiglo482 ENDIF483 IF( njctls < 1 .OR. njctls > jpjglo ) THEN484 CALL ctl_warn( ' - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )485 njctls = 1486 ENDIF487 IF( njctle < 1 .OR. njctle > jpjglo ) THEN488 CALL ctl_warn( ' - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )489 njctle = jpjglo490 ENDIF491 ENDIF492 ENDIF493 443 ! 494 444 IF( 1._wp /= SIGN(1._wp,-0._wp) ) CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.', & … … 544 494 ierr = dia_wri_alloc() 545 495 ierr = ierr + dom_oce_alloc() ! ocean domain 546 ierr = ierr + oce_alloc () ! (ts n...) needed for agrif and/or SI3 and bdy496 ierr = ierr + oce_alloc () ! (ts...) needed for agrif and/or SI3 and bdy 547 497 ierr = ierr + bdy_oce_alloc() ! bdy masks (incl. initialization) 548 498 ! … … 552 502 END SUBROUTINE nemo_alloc 553 503 554 SUBROUTINE nemo_set_cfctl(sn_cfctl, setto , for_all)504 SUBROUTINE nemo_set_cfctl(sn_cfctl, setto ) 555 505 !!---------------------------------------------------------------------- 556 506 !! *** ROUTINE nemo_set_cfctl *** 557 507 !! 558 508 !! ** Purpose : Set elements of the output control structure to setto. 559 !! for_all should be .false. unless all areas are to be560 !! treated identically.561 509 !! 562 510 !! ** Method : Note this routine can be used to switch on/off some 563 !! types of output for selected areas but any output types 564 !! that involve global communications (e.g. mpp_max, glob_sum) 565 !! should be protected from selective switching by the 566 !! for_all argument 567 !!---------------------------------------------------------------------- 568 LOGICAL :: setto, for_all 569 TYPE(sn_ctl) :: sn_cfctl 570 !!---------------------------------------------------------------------- 571 IF( for_all ) THEN 572 sn_cfctl%l_runstat = setto 573 sn_cfctl%l_trcstat = setto 574 ENDIF 511 !! types of output for selected areas. 512 !!---------------------------------------------------------------------- 513 TYPE(sn_ctl), INTENT(inout) :: sn_cfctl 514 LOGICAL , INTENT(in ) :: setto 515 !!---------------------------------------------------------------------- 516 sn_cfctl%l_runstat = setto 517 sn_cfctl%l_trcstat = setto 575 518 sn_cfctl%l_oceout = setto 576 519 sn_cfctl%l_layout = setto -
NEMO/branches/2020/dev_12905_xios_ancil/src/SAS/sbcssm.F90
r12615 r13766 290 290 ! ! fill sf with slf_i and control print 291 291 CALL fld_fill( sf_ssm_3d, slf_3d, cn_dir, 'sbc_ssm_init', '3D Data in file', 'namsbc_ssm' ) 292 sf_ssm_3d(jf_usp)%cltype = 'U' ; sf_ssm_3d(jf_usp)%zsgn = -1._wp 293 sf_ssm_3d(jf_vsp)%cltype = 'V' ; sf_ssm_3d(jf_vsp)%zsgn = -1._wp 292 294 ENDIF 293 295 ! … … 306 308 ! 307 309 CALL fld_fill( sf_ssm_2d, slf_2d, cn_dir, 'sbc_ssm_init', '2D Data in file', 'namsbc_ssm' ) 310 IF( .NOT. ln_3d_uve ) THEN 311 sf_ssm_2d(jf_usp)%cltype = 'U' ; sf_ssm_2d(jf_usp)%zsgn = -1._wp 312 sf_ssm_2d(jf_vsp)%cltype = 'V' ; sf_ssm_2d(jf_vsp)%zsgn = -1._wp 313 ENDIF 308 314 ENDIF 309 315 ! -
NEMO/branches/2020/dev_12905_xios_ancil/src/SAS/step.F90
r12650 r13766 74 74 !! -2- Outputs and diagnostics 75 75 !!---------------------------------------------------------------------- 76 INTEGER :: indic ! error indicator if < 077 !! ---------------------------------------------------------------------78 76 79 77 #if defined key_agrif 80 IF( nstop > 0 ) return ! avoid to go further if an error was detected during previous time step78 IF( nstop > 0 ) RETURN ! avoid to go further if an error was detected during previous time step (child grid) 81 79 kstp = nit000 + Agrif_Nb_Step() 82 80 Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs ! agrif_oce module copies of time level indices 83 IF 84 IF ( Agrif_Root() .and. lwp) Write(*,*) '---'85 IF (lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp, 'int tstep',Agrif_NbStepint()81 IF( lk_agrif_debug ) THEN 82 IF( Agrif_Root() .and. lwp) WRITE(*,*) '---' 83 IF(lwp) WRITE(*,*) 'Grid Number', Agrif_Fixed(),' time step ', kstp, 'int tstep', Agrif_NbStepint() 86 84 ENDIF 87 88 IF ( kstp == (nit000 + 1) ) lk_agrif_fstep = .FALSE. 89 85 IF( kstp == nit000 + 1 ) lk_agrif_fstep = .FALSE. 90 86 # if defined key_iomput 91 87 IF( Agrif_Nbstepint() == 0 ) CALL iom_swap( cxios_context ) 92 88 # endif 93 89 #endif 94 indic = 0 ! although indic is not changed in stp_ctl95 ! need to keep the same interface96 90 IF( kstp == nit000 ) CALL iom_init( cxios_context ) ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 97 91 IF( kstp /= nit000 ) CALL day( kstp ) ! Calendar (day was already called at nit000 in day_init) … … 112 106 ! AGRIF recursive integration 113 107 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 114 CALL Agrif_Integrate_ChildGrids( stp ) 115 #endif 108 CALL Agrif_Integrate_ChildGrids( stp ) 116 109 110 #endif 117 111 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 118 112 ! Control 119 113 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 120 CALL stp_ctl( kstp, indic ) 121 IF( indic < 0 ) THEN 122 CALL ctl_stop( 'step: indic < 0' ) 123 CALL dia_wri_state( Nnn, 'output.abort' ) 124 ENDIF 114 CALL stp_ctl( kstp, Nnn ) 115 125 116 #if defined key_agrif 126 117 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 132 123 #endif 133 124 ENDIF 125 134 126 #endif 135 127 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 141 133 ! Coupled mode 142 134 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 143 IF( lk_oasis ) CALL sbc_cpl_snd( kstp, Nbb, Nnn )! coupled mode : field exchanges if OASIS-coupled ice135 IF( lk_oasis .AND. nstop == 0 ) CALL sbc_cpl_snd( kstp, Nbb, Nnn ) ! coupled mode : field exchanges if OASIS-coupled ice 144 136 145 137 #if defined key_iomput … … 152 144 lrst_oce = .FALSE. 153 145 ENDIF 154 IF( kstp == nitend .OR. indic <0 ) THEN155 146 IF( kstp == nitend .OR. nstop > 0 ) THEN 147 CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF 156 148 ENDIF 157 149 #endif -
NEMO/branches/2020/dev_12905_xios_ancil/src/SAS/stpctl.F90
r12377 r13766 20 20 USE dom_oce ! ocean space and time domain variables 21 21 USE ice , ONLY : vt_i, u_ice, tm_i 22 USE phycst , ONLY : rt0 23 USE sbc_oce , ONLY : lk_oasis 22 24 ! 25 USE diawri ! Standard run outputs (dia_wri_state routine) 23 26 USE in_out_manager ! I/O manager 24 27 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 25 28 USE lib_mpp ! distributed memory computing 26 29 ! 27 30 USE netcdf ! NetCDF library 28 31 IMPLICIT NONE … … 31 34 PUBLIC stp_ctl ! routine called by step.F90 32 35 33 INTEGER :: idrun, idtime, idssh, idu, ids, istatus34 LOGICAL :: lsomeoce36 INTEGER :: nrunid ! netcdf file id 37 INTEGER, DIMENSION(3) :: nvarid ! netcdf variable id 35 38 !!---------------------------------------------------------------------- 36 39 !! NEMO/SAS 4.0 , NEMO Consortium (2018) … … 38 41 !! Software governed by the CeCILL license (see ./LICENSE) 39 42 !!---------------------------------------------------------------------- 40 41 43 CONTAINS 42 44 43 SUBROUTINE stp_ctl( kt, kindic)45 SUBROUTINE stp_ctl( kt, Kmm ) 44 46 !!---------------------------------------------------------------------- 45 47 !! *** ROUTINE stp_ctl *** … … 48 50 !! 49 51 !! ** Method : - Save the time step in numstp 50 !! - Print it each 50 time steps 52 !! - Stop the run IF problem encountered by setting nstop > 0 53 !! Problems checked: ice thickness maximum > 100 m 54 !! ice velocity maximum > 10 m/s 55 !! min ice temperature < -100 degC 51 56 !! 52 57 !! ** Actions : "time.step" file = last ocean time-step 53 58 !! "run.stat" file = run statistics 54 !! 55 !!---------------------------------------------------------------------- 56 INTEGER, INTENT( in ) :: kt ! ocean time-step index 57 INTEGER, INTENT( inout ) :: kindic ! indicator of solver convergence 58 !! 59 REAL(wp), DIMENSION(3) :: zmax 60 LOGICAL :: ll_wrtstp, ll_colruns, ll_wrtruns 61 CHARACTER(len=20) :: clname 62 !!---------------------------------------------------------------------- 63 ! 64 ll_wrtstp = ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 65 ll_colruns = ll_wrtstp .AND. ( sn_cfctl%l_runstat ) 66 ll_wrtruns = ll_colruns .AND. lwm 67 IF( kt == nit000 .AND. lwp ) THEN 68 WRITE(numout,*) 69 WRITE(numout,*) 'stp_ctl : time-stepping control' 70 WRITE(numout,*) '~~~~~~~' 71 ! ! open time.step file 72 IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 73 ! ! open run.stat file(s) at start whatever 74 ! ! the value of sn_cfctl%ptimincr 75 IF( lwm .AND. ( sn_cfctl%l_runstat ) ) THEN 76 CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 77 clname = 'run.stat.nc' 59 !! nstop indicator sheared among all local domain 60 !!---------------------------------------------------------------------- 61 INTEGER, INTENT(in ) :: kt ! ocean time-step index 62 INTEGER, INTENT(in ) :: Kmm ! ocean time level index 63 !! 64 INTEGER :: ji ! dummy loop indices 65 INTEGER :: idtime, istatus 66 INTEGER , DIMENSION(4) :: iareasum, iareamin, iareamax 67 INTEGER , DIMENSION(3,3) :: iloc ! min/max loc indices 68 REAL(wp) :: zzz ! local real 69 REAL(wp), DIMENSION(4) :: zmax, zmaxlocal 70 LOGICAL :: ll_wrtstp, ll_colruns, ll_wrtruns, ll_0oce 71 LOGICAL, DIMENSION(jpi,jpj) :: llmsk 72 CHARACTER(len=20) :: clname 73 !!---------------------------------------------------------------------- 74 IF( nstop > 0 .AND. ngrdstop > -1 ) RETURN ! stpctl was already called by a child grid 75 ! 76 ll_wrtstp = ( MOD( kt-nit000, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 77 ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1 78 ll_wrtruns = ( ll_colruns .OR. jpnij == 1 ) .AND. lwm 79 ! 80 IF( kt == nit000 ) THEN 81 ! 82 IF( lwp ) THEN 83 WRITE(numout,*) 84 WRITE(numout,*) 'stp_ctl : time-stepping control' 85 WRITE(numout,*) '~~~~~~~' 86 ENDIF 87 ! ! open time.step ascii file, done only by 1st subdomain 88 IF( lk_oasis ) THEN ; clname = 'time_sas.step' 89 ELSE ; clname = 'time.step' 90 ENDIF 91 IF( lwm ) CALL ctl_opn( numstp, clname, 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 92 ! 93 IF( ll_wrtruns ) THEN 94 IF( lk_oasis ) THEN ; clname = 'run_sas.stat' 95 ELSE ; clname = 'run.stat' 96 ENDIF 97 ! ! open run.stat ascii file, done only by 1st subdomain 98 CALL ctl_opn( numrun, clname, 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 99 ! ! open run.stat.nc netcdf file, done only by 1st subdomain 100 clname = TRIM(clname)//'.nc' 78 101 IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 79 istatus = NF90_CREATE( 'run.stat.nc', NF90_CLOBBER, idrun ) 80 istatus = NF90_DEF_DIM( idrun, 'time' , NF90_UNLIMITED, idtime ) 81 istatus = NF90_DEF_VAR( idrun, 'vt_i_max' , NF90_DOUBLE, (/ idtime /), idssh ) 82 istatus = NF90_DEF_VAR( idrun, 'abs_u_max', NF90_DOUBLE, (/ idtime /), idu ) 83 istatus = NF90_DEF_VAR( idrun, 'tm_i_min' , NF90_DOUBLE, (/ idtime /), ids ) 84 istatus = NF90_ENDDEF(idrun) 85 ENDIF 86 ENDIF 87 IF( kt == nit000 ) lsomeoce = COUNT( ssmask(:,:) == 1._wp ) > 0 88 ! 89 IF(lwm .AND. ll_wrtstp) THEN !== current time step ==! ("time.step" file) 102 istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, nrunid ) 103 istatus = NF90_DEF_DIM( nrunid, 'time' , NF90_UNLIMITED, idtime ) 104 istatus = NF90_DEF_VAR( nrunid, 'vt_i_max' , NF90_DOUBLE, (/ idtime /), nvarid(1) ) 105 istatus = NF90_DEF_VAR( nrunid, 'abs_u_max', NF90_DOUBLE, (/ idtime /), nvarid(2) ) 106 istatus = NF90_DEF_VAR( nrunid, 'tm_i_min' , NF90_DOUBLE, (/ idtime /), nvarid(3) ) 107 istatus = NF90_ENDDEF(nrunid) 108 ENDIF 109 ! 110 ENDIF 111 ! 112 ! !== write current time step ==! 113 ! !== done only by 1st subdomain at writting timestep ==! 114 IF( lwm .AND. ll_wrtstp ) THEN 90 115 WRITE ( numstp, '(1x, i8)' ) kt 91 116 REWIND( numstp ) 92 117 ENDIF 93 ! !== test of extrema ==! 118 ! !== test of local extrema ==! 119 ! !== done by all processes at every time step ==! 120 ! 121 llmsk( 1:Nis1,:) = .FALSE. ! exclude halos from the checked region 122 llmsk(Nie1: jpi,:) = .FALSE. 123 llmsk(:, 1:Njs1) = .FALSE. 124 llmsk(:,Nje1: jpj) = .FALSE. 125 ! 126 llmsk(Nis0:Nie0,Njs0:Nje0) = tmask(Nis0:Nie0,Njs0:Nje0,1) == 1._wp ! test only the inner domain 127 ! 128 ll_0oce = .NOT. ANY( llmsk(:,:) ) ! no ocean point in the inner domain? 129 ! 130 zmax(1) = MAXVAL( vt_i (:,:) , mask = llmsk ) ! max ice thickness 131 zmax(2) = MAXVAL( ABS( u_ice(:,:) ) , mask = llmsk ) ! max ice velocity (zonal only) 132 zmax(3) = MAXVAL( -tm_i (:,:) + rt0, mask = llmsk ) ! min ice temperature (in degC) 133 zmax(4) = REAL( nstop, wp ) ! stop indicator 134 ! 135 ! !== get global extrema ==! 136 ! !== done by all processes if writting run.stat ==! 94 137 IF( ll_colruns ) THEN 95 zmax(1) = MAXVAL( vt_i (:,:) ) ! max ice thickness 96 zmax(2) = MAXVAL( ABS( u_ice(:,:) ) ) ! max ice velocity (zonal only) 97 zmax(3) = MAXVAL( -tm_i (:,:)+273.15_wp , mask = ssmask(:,:) == 1._wp ) ! min ice temperature 98 CALL mpp_max( "stpctl", zmax ) ! max over the global domain 138 zmaxlocal(:) = zmax(:) 139 CALL mpp_max( "stpctl", zmax ) ! max over the global domain: ok even of ll_0oce = .true. 140 nstop = NINT( zmax(4) ) ! update nstop indicator (now sheared among all local domains) 141 ELSE 142 ! if no ocean point: MAXVAL returns -HUGE => we must overwrite this value to avoid error handling bellow. 143 IF( ll_0oce ) zmax(1:3) = 0._wp ! default "valid" values... 144 ENDIF 145 ! 146 zmax(3) = -zmax(3) ! move back from max(-zz) to min(zz) : easier to manage! 147 IF( ll_colruns ) zmaxlocal(3) = -zmaxlocal(3) ! move back from max(-zz) to min(zz) : easier to manage! 148 ! 149 ! !== write "run.stat" files ==! 150 ! !== done only by 1st subdomain at writting timestep ==! 151 IF( ll_wrtruns ) THEN 152 WRITE(numrun,9500) kt, zmax(1), zmax(2), zmax(3) 153 DO ji = 1, 3 154 istatus = NF90_PUT_VAR( nrunid, nvarid(ji), (/zmax(ji)/), (/kt/), (/1/) ) 155 END DO 156 IF( kt == nitend ) istatus = NF90_CLOSE(nrunid) 99 157 END IF 100 ! !== run statistics ==! ("run.stat" file) 101 IF( ll_wrtruns ) THEN 102 WRITE(numrun,9500) kt, zmax(1), zmax(2), - zmax(3) 103 istatus = NF90_PUT_VAR( idrun, idssh, (/ zmax(1)/), (/kt/), (/1/) ) 104 istatus = NF90_PUT_VAR( idrun, idu, (/ zmax(2)/), (/kt/), (/1/) ) 105 istatus = NF90_PUT_VAR( idrun, ids, (/-zmax(3)/), (/kt/), (/1/) ) 106 IF( MOD( kt , 100 ) == 0 ) istatus = NF90_SYNC(idrun) 107 IF( kt == nitend ) istatus = NF90_CLOSE(idrun) 108 END IF 158 ! !== error handling ==! 159 ! !== done by all processes at every time step ==! 160 ! 161 IF( zmax(1) > 100._wp .OR. & ! too large ice thickness maximum ( > 100 m) 162 & zmax(2) > 10._wp .OR. & ! too large ice velocity ( > 10 m/s) 163 & zmax(3) < -101._wp .OR. & ! too cold ice temperature ( < -100 degC) 164 & ISNAN( zmax(1) + zmax(2) + zmax(3) ) .OR. & ! NaN encounter in the tests 165 & ABS( zmax(1) + zmax(2) + zmax(3) ) > HUGE(1._wp) ) THEN ! Infinity encounter in the tests 166 ! 167 iloc(:,:) = 0 168 IF( ll_colruns ) THEN ! zmax is global, so it is the same on all subdomains -> no dead lock with mpp_maxloc 169 ! first: close the netcdf file, so we can read it 170 IF( lwm .AND. kt /= nitend ) istatus = NF90_CLOSE(nrunid) 171 ! get global loc on the min/max 172 CALL mpp_maxloc( 'stpctl', vt_i(:,:) , llmsk, zzz, iloc(1:2,1) ) ! mpp_maxloc ok if mask = F 173 CALL mpp_maxloc( 'stpctl',ABS( u_ice(:,:) ) , llmsk, zzz, iloc(1:2,2) ) 174 CALL mpp_minloc( 'stpctl', tm_i(:,:) - rt0, llmsk, zzz, iloc(1:2,3) ) 175 ! find which subdomain has the max. 176 iareamin(:) = jpnij+1 ; iareamax(:) = 0 ; iareasum(:) = 0 177 DO ji = 1, 4 178 IF( zmaxlocal(ji) == zmax(ji) ) THEN 179 iareamin(ji) = narea ; iareamax(ji) = narea ; iareasum(ji) = 1 180 ENDIF 181 END DO 182 CALL mpp_min( "stpctl", iareamin ) ! min over the global domain 183 CALL mpp_max( "stpctl", iareamax ) ! max over the global domain 184 CALL mpp_sum( "stpctl", iareasum ) ! sum over the global domain 185 ELSE ! find local min and max locations: 186 ! if we are here, this means that the subdomain contains some oce points -> no need to test the mask used in maxloc 187 iloc(1:2,1) = MAXLOC( vt_i(:,:) , mask = llmsk ) 188 iloc(1:2,2) = MAXLOC( ABS( u_ice(:,:) ) , mask = llmsk ) 189 iloc(1:2,3) = MINLOC( tm_i(:,:) - rt0, mask = llmsk ) 190 DO ji = 1, 3 ! local domain indices ==> global domain indices, excluding halos 191 iloc(1:2,ji) = (/ mig0(iloc(1,ji)), mjg0(iloc(2,ji)) /) 192 END DO 193 iareamin(:) = narea ; iareamax(:) = narea ; iareasum(:) = 1 ! this is local information 194 ENDIF 195 ! 196 WRITE(ctmp1,*) ' stp_ctl: ice_thick > 100 m or |ice_vel| > 10 m/s or ice_temp < -100 degC or NaN encounter in the tests' 197 CALL wrt_line( ctmp2, kt, 'ice_thick max', zmax(1), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) ) 198 CALL wrt_line( ctmp3, kt, '|ice_vel| max', zmax(2), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) ) 199 CALL wrt_line( ctmp4, kt, 'ice_temp min', zmax(3), iloc(:,3), iareasum(3), iareamin(3), iareamax(3) ) 200 IF( Agrif_Root() ) THEN 201 WRITE(ctmp6,*) ' ===> output of last computed fields in output.abort* files' 202 ELSE 203 WRITE(ctmp6,*) ' ===> output of last computed fields in '//TRIM(Agrif_CFixed())//'_output.abort* files' 204 ENDIF 205 ! 206 CALL dia_wri_state( Kmm, 'output.abort' ) ! create an output.abort file 207 ! 208 IF( ll_colruns .or. jpnij == 1 ) THEN ! all processes synchronized -> use lwp to print in opened ocean.output files 209 IF(lwp) THEN ; CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 210 ELSE ; nstop = MAX(1, nstop) ! make sure nstop > 0 (automatically done when calling ctl_stop) 211 ENDIF 212 ELSE ! only mpi subdomains with errors are here -> STOP now 213 CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 214 ENDIF 215 ! 216 ENDIF 217 ! 218 IF( nstop > 0 ) THEN ! an error was detected and we did not abort yet... 219 ngrdstop = Agrif_Fixed() ! store which grid got this error 220 IF( .NOT. ll_colruns .AND. jpnij > 1 ) CALL ctl_stop( 'STOP' ) ! we must abort here to avoid MPI deadlock 221 ENDIF 109 222 ! 110 223 9500 FORMAT(' it :', i8, ' vt_i_max: ', D23.16, ' |u|_max: ', D23.16,' tm_i_min: ', D23.16) 111 224 ! 112 225 END SUBROUTINE stp_ctl 226 227 228 SUBROUTINE wrt_line( cdline, kt, cdprefix, pval, kloc, ksum, kmin, kmax ) 229 !!---------------------------------------------------------------------- 230 !! *** ROUTINE wrt_line *** 231 !! 232 !! ** Purpose : write information line 233 !! 234 !!---------------------------------------------------------------------- 235 CHARACTER(len=*), INTENT( out) :: cdline 236 CHARACTER(len=*), INTENT(in ) :: cdprefix 237 REAL(wp), INTENT(in ) :: pval 238 INTEGER, DIMENSION(3), INTENT(in ) :: kloc 239 INTEGER, INTENT(in ) :: kt, ksum, kmin, kmax 240 ! 241 CHARACTER(len=80) :: clsuff 242 CHARACTER(len=9 ) :: clkt, clsum, clmin, clmax 243 CHARACTER(len=9 ) :: cli, clj, clk 244 CHARACTER(len=1 ) :: clfmt 245 CHARACTER(len=4 ) :: cl4 ! needed to be able to compile with Agrif, I don't know why 246 INTEGER :: ifmtk 247 !!---------------------------------------------------------------------- 248 WRITE(clkt , '(i9)') kt 249 250 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpnij ,wp))) + 1 ! how many digits to we need to write ? (we decide max = 9) 251 !!! WRITE(clsum, '(i'//clfmt//')') ksum ! this is creating a compilation error with AGRIF 252 cl4 = '(i'//clfmt//')' ; WRITE(clsum, cl4) ksum 253 WRITE(clfmt, '(i1)') INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1 ! how many digits to we need to write ? (we decide max = 9) 254 cl4 = '(i'//clfmt//')' ; WRITE(clmin, cl4) kmin-1 255 WRITE(clmax, cl4) kmax-1 256 ! 257 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpiglo,wp))) + 1 ! how many digits to we need to write jpiglo? (we decide max = 9) 258 cl4 = '(i'//clfmt//')' ; WRITE(cli, cl4) kloc(1) ! this is ok with AGRIF 259 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpjglo,wp))) + 1 ! how many digits to we need to write jpjglo? (we decide max = 9) 260 cl4 = '(i'//clfmt//')' ; WRITE(clj, cl4) kloc(2) ! this is ok with AGRIF 261 ! 262 IF( ksum == 1 ) THEN ; WRITE(clsuff,9100) TRIM(clmin) 263 ELSE ; WRITE(clsuff,9200) TRIM(clsum), TRIM(clmin), TRIM(clmax) 264 ENDIF 265 IF(kloc(3) == 0) THEN 266 ifmtk = INT(LOG10(REAL(jpk,wp))) + 1 ! how many digits to we need to write jpk? (we decide max = 9) 267 clk = REPEAT(' ', ifmtk) ! create the equivalent in blank string 268 WRITE(cdline,9300) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj), clk(1:ifmtk), TRIM(clsuff) 269 ELSE 270 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpk,wp))) + 1 ! how many digits to we need to write jpk? (we decide max = 9) 271 !!! WRITE(clk, '(i'//clfmt//')') kloc(3) ! this is creating a compilation error with AGRIF 272 cl4 = '(i'//clfmt//')' ; WRITE(clk, cl4) kloc(3) ! this is ok with AGRIF 273 WRITE(cdline,9400) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj), TRIM(clk), TRIM(clsuff) 274 ENDIF 275 ! 276 9100 FORMAT('MPI rank ', a) 277 9200 FORMAT('found in ', a, ' MPI tasks, spread out among ranks ', a, ' to ', a) 278 9300 FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j ', a, ' ', a, ' ', a, ' ', a) 279 9400 FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j k ', a, ' ', a, ' ', a, ' ', a) 280 ! 281 END SUBROUTINE wrt_line 282 113 283 114 284 !!======================================================================
Note: See TracChangeset
for help on using the changeset viewer.
