- Timestamp:
- 2020-06-26T10:26:32+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement
- Files:
-
- 6 edited
-
. (modified) (1 prop)
-
src/SAS/diawri.F90 (modified) (9 diffs)
-
src/SAS/nemogcm.F90 (modified) (7 diffs)
-
src/SAS/sbcssm.F90 (modified) (12 diffs)
-
src/SAS/step.F90 (modified) (3 diffs)
-
src/SAS/stpctl.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement
- Property svn:externals
-
old new 8 8 9 9 # SETTE 10 ^/utils/CI/sette@ HEADsette10 ^/utils/CI/sette@12931 sette
-
- Property svn:externals
-
NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/SAS/diawri.F90
r12489 r13159 99 99 ! Output the initial state and forcings 100 100 IF( ninist == 1 ) THEN 101 CALL dia_wri_state( 'output.init', Kmm)101 CALL dia_wri_state( Kmm, 'output.init' ) 102 102 ninist = 0 103 103 ENDIF … … 126 126 END FUNCTION dia_wri_alloc_abl 127 127 128 SUBROUTINE dia_wri( kt )128 SUBROUTINE dia_wri( kt, Kmm ) 129 129 !!--------------------------------------------------------------------- 130 130 !! *** ROUTINE dia_wri *** … … 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 141 INTEGER, INTENT( in ) :: Kmm ! ocean time level index 142 142 !! 143 143 LOGICAL :: ll_print = .FALSE. ! =T print and flush numout … … 154 154 ! Output the initial state and forcings 155 155 IF( ninist == 1 ) THEN 156 CALL dia_wri_state( 'output.init' )156 CALL dia_wri_state( Kmm, 'output.init' ) 157 157 ninist = 0 158 158 ENDIF … … 257 257 IF( ln_abl ) THEN 258 258 ! Define the ABL grid FILE ( nid_A ) 259 CALL dia_nam( clhstnam, n write, 'grid_ABL' )259 CALL dia_nam( clhstnam, nn_write, 'grid_ABL' ) 260 260 IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam ! filename 261 261 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & ! Horizontal grid: glamt and gphit … … 414 414 #endif 415 415 416 SUBROUTINE dia_wri_state( cdfile_name, Kmm)416 SUBROUTINE dia_wri_state( Kmm, cdfile_name ) 417 417 !!--------------------------------------------------------------------- 418 418 !! *** ROUTINE dia_wri_state *** … … 427 427 !! File 'output.abort.nc' is created in case of abnormal job end 428 428 !!---------------------------------------------------------------------- 429 INTEGER , INTENT( in ) :: Kmm ! ocean time levelindex 429 430 CHARACTER (len=* ), INTENT( in ) :: cdfile_name ! name of the file created 430 INTEGER , INTENT( in ) :: Kmm ! ocean time levelindex431 431 !! 432 432 INTEGER :: inum … … 437 437 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~ and forcing fields file created ' 438 438 IF(lwp) WRITE(numout,*) ' and named :', cdfile_name, '...nc' 439 440 #if defined key_si3 441 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl ) 442 #else 443 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. ) 444 #endif 445 439 ! 440 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. ) 441 ! 446 442 CALL iom_rstput( 0, 0, inum, 'votemper', ts (:,:,:,jp_tem,Kmm) ) ! now temperature 447 443 CALL iom_rstput( 0, 0, inum, 'vosaline', ts (:,:,:,jp_sal,Kmm) ) ! now salinity … … 456 452 CALL iom_rstput( 0, 0, inum, 'sozotaux', utau ) ! i-wind stress 457 453 CALL iom_rstput( 0, 0, inum, 'sometauy', vtau ) ! j-wind stress 458 454 ! 455 CALL iom_close( inum ) 456 ! 459 457 #if defined key_si3 460 458 IF( nn_ice == 2 ) THEN ! condition needed in case agrif + ice-model but no-ice in child grid 459 CALL iom_open( TRIM(cdfile_name)//'_ice', inum, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' ) 461 460 CALL ice_wri_state( inum ) 462 ENDIF 463 #endif 464 ! 465 CALL iom_close( inum ) 466 ! 461 CALL iom_close( inum ) 462 ENDIF 463 ! 464 #endif 467 465 END SUBROUTINE dia_wri_state 468 466 -
NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/SAS/nemogcm.F90
r12489 r13159 35 35 USE step_diu ! diurnal bulk SST timestepping (called from here if run offline) 36 36 ! 37 USE in_out_manager ! I/O manager 37 38 USE lib_mpp ! distributed memory computing 38 39 USE mppini ! shared/distributed memory setting (mpp_init routine) … … 125 126 END DO 126 127 ! 127 IF( .NOT. Agrif_Root() ) THEN128 CALL Agrif_ParentGrid_To_ChildGrid()129 IF( ln_timing ) CALL timing_finalize130 CALL Agrif_ChildGrid_To_ParentGrid()131 ENDIF132 !133 128 #else 134 129 ! … … 165 160 IF( nstop /= 0 .AND. lwp ) THEN ! error print 166 161 WRITE(ctmp1,*) ' ==>>> nemo_gcm: a total of ', nstop, ' errors have been found' 167 CALL ctl_stop( ctmp1 ) 162 IF( ngrdstop > 0 ) THEN 163 WRITE(ctmp9,'(i2)') ngrdstop 164 WRITE(ctmp2,*) ' E R R O R detected in Agrif grid '//TRIM(ctmp9) 165 WRITE(ctmp3,*) ' Look for "E R R O R" messages in all existing '//TRIM(ctmp9)//'_ocean_output* files' 166 CALL ctl_stop( ' ', ctmp1, ' ', ctmp2, ' ', ctmp3 ) 167 ELSE 168 WRITE(ctmp2,*) ' Look for "E R R O R" messages in all existing ocean_output* files' 169 CALL ctl_stop( ' ', ctmp1, ' ', ctmp2 ) 170 ENDIF 168 171 ENDIF 169 172 ! … … 256 259 ENDIF 257 260 ! open /dev/null file to be able to supress output write easily 261 IF( Agrif_Root() ) THEN 258 262 CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 263 #ifdef key_agrif 264 ELSE 265 numnul = Agrif_Parent(numnul) 266 #endif 267 ENDIF 259 268 ! 260 269 ! !--------------------! … … 268 277 ! 269 278 ! finalize the definition of namctl variables 270 IF( sn_cfctl%l_allon ) THEN 271 ! Turn on all options. 272 CALL nemo_set_cfctl( sn_cfctl, .TRUE., .TRUE. ) 273 ! Ensure all processors are active 274 sn_cfctl%procmin = 0 ; sn_cfctl%procmax = 1000000 ; sn_cfctl%procincr = 1 275 ELSEIF( sn_cfctl%l_config ) THEN 276 ! Activate finer control of report outputs 277 ! optionally switch off output from selected areas (note this only 278 ! applies to output which does not involve global communications) 279 IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax ) .OR. & 280 & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) ) & 281 & CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 282 ELSE 283 ! turn off all options. 284 CALL nemo_set_cfctl( sn_cfctl, .FALSE., .TRUE. ) 285 ENDIF 279 IF( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax .OR. MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) & 280 & CALL nemo_set_cfctl( sn_cfctl, .FALSE. ) 286 281 ! 287 282 lwp = (narea == 1) .OR. sn_cfctl%l_oceout ! control of all listing output print … … 401 396 WRITE(numout,*) '~~~~~~~~' 402 397 WRITE(numout,*) ' Namelist namctl' 403 WRITE(numout,*) ' sn_cfctl%l_glochk = ', sn_cfctl%l_glochk404 WRITE(numout,*) ' sn_cfctl%l_allon = ', sn_cfctl%l_allon405 WRITE(numout,*) ' finer control over o/p sn_cfctl%l_config = ', sn_cfctl%l_config406 398 WRITE(numout,*) ' sn_cfctl%l_runstat = ', sn_cfctl%l_runstat 407 399 WRITE(numout,*) ' sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat … … 545 537 END SUBROUTINE nemo_alloc 546 538 547 SUBROUTINE nemo_set_cfctl(sn_cfctl, setto , for_all)539 SUBROUTINE nemo_set_cfctl(sn_cfctl, setto ) 548 540 !!---------------------------------------------------------------------- 549 541 !! *** ROUTINE nemo_set_cfctl *** 550 542 !! 551 543 !! ** Purpose : Set elements of the output control structure to setto. 552 !! for_all should be .false. unless all areas are to be553 !! treated identically.554 544 !! 555 545 !! ** Method : Note this routine can be used to switch on/off some 556 !! types of output for selected areas but any output types 557 !! that involve global communications (e.g. mpp_max, glob_sum) 558 !! should be protected from selective switching by the 559 !! for_all argument 560 !!---------------------------------------------------------------------- 561 LOGICAL :: setto, for_all 562 TYPE(sn_ctl) :: sn_cfctl 563 !!---------------------------------------------------------------------- 564 IF( for_all ) THEN 565 sn_cfctl%l_runstat = setto 566 sn_cfctl%l_trcstat = setto 567 ENDIF 546 !! types of output for selected areas. 547 !!---------------------------------------------------------------------- 548 TYPE(sn_ctl), INTENT(inout) :: sn_cfctl 549 LOGICAL , INTENT(in ) :: setto 550 !!---------------------------------------------------------------------- 551 sn_cfctl%l_runstat = setto 552 sn_cfctl%l_trcstat = setto 568 553 sn_cfctl%l_oceout = setto 569 554 sn_cfctl%l_layout = setto -
NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/SAS/sbcssm.F90
r12377 r13159 26 26 USE lib_mpp ! distributed memory computing library 27 27 USE prtctl ! print control 28 USE fldread ! read input fields 28 USE fldread ! read input fields 29 29 USE timing ! Timing 30 30 … … 38 38 LOGICAL :: ln_3d_uve ! specify whether input velocity data is 3D 39 39 LOGICAL :: ln_read_frq ! specify whether we must read frq or not 40 40 41 41 LOGICAL :: l_sasread ! Ice intilisation: =T read a file ; =F anaytical initilaistion 42 42 LOGICAL :: l_initdone = .false. … … 69 69 !! for an off-line simulation using surface processes only 70 70 !! 71 !! ** Method : calculates the position of data 71 !! ** Method : calculates the position of data 72 72 !! - interpolates data if needed 73 73 !!---------------------------------------------------------------------- 74 74 INTEGER, INTENT(in) :: kt ! ocean time-step index 75 75 INTEGER, INTENT(in) :: Kbb, Kmm ! ocean time level indices 76 76 ! (not needed for SAS but needed to keep a consistent interface in sbcmod.F90) 77 77 ! 78 78 INTEGER :: ji, jj ! dummy loop indices … … 82 82 ! 83 83 IF( ln_timing ) CALL timing_start( 'sbc_ssm') 84 84 85 85 IF ( l_sasread ) THEN 86 86 IF( nfld_3d > 0 ) CALL fld_read( kt, 1, sf_ssm_3d ) !== read data at kt time step ==! 87 87 IF( nfld_2d > 0 ) CALL fld_read( kt, 1, sf_ssm_2d ) !== read data at kt time step ==! 88 ! 88 ! 89 89 IF( ln_3d_uve ) THEN 90 90 IF( .NOT. ln_linssh ) THEN 91 e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor 91 e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor 92 92 ELSE 93 93 e3t_m(:,:) = e3t_0(:,:,1) ! vertical scale factor 94 94 ENDIF 95 95 ssu_m(:,:) = sf_ssm_3d(jf_usp)%fnow(:,:,1) * umask(:,:,1) ! u-velocity 96 ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity 96 ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity 97 97 ELSE 98 98 IF( .NOT. ln_linssh ) THEN 99 e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor 99 e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor 100 100 ELSE 101 101 e3t_m(:,:) = e3t_0(:,:,1) ! vertical scale factor 102 102 ENDIF 103 103 ssu_m(:,:) = sf_ssm_2d(jf_usp)%fnow(:,:,1) * umask(:,:,1) ! u-velocity 104 ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity 104 ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity 105 105 ENDIF 106 106 ! … … 123 123 ssh (:,:,Kmm) = 0._wp ! - - 124 124 ENDIF 125 125 126 126 IF ( nn_ice == 1 ) THEN 127 127 ts(:,:,1,jp_tem,Kmm) = sst_m(:,:) … … 132 132 uu (:,:,1,Kbb) = ssu_m(:,:) 133 133 vv (:,:,1,Kbb) = ssv_m(:,:) 134 134 135 135 IF(sn_cfctl%l_prtctl) THEN ! print control 136 136 CALL prt_ctl(tab2d_1=sst_m, clinfo1=' sst_m - : ', mask1=tmask ) … … 162 162 !! *** ROUTINE sbc_ssm_init *** 163 163 !! 164 !! ** Purpose : Initialisation of sea surface mean data 165 !!---------------------------------------------------------------------- 166 INTEGER, INTENT(in) :: Kbb, Kmm ! ocean time level indices 167 164 !! ** Purpose : Initialisation of sea surface mean data 165 !!---------------------------------------------------------------------- 166 INTEGER, INTENT(in) :: Kbb, Kmm ! ocean time level indices 167 ! (not needed for SAS but needed to keep a consistent interface in sbcmod.F90) 168 168 INTEGER :: ierr, ierr0, ierr1, ierr2, ierr3 ! return error code 169 169 INTEGER :: ifpr ! dummy loop indice … … 195 195 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namsbc_sas in configuration namelist' ) 196 196 IF(lwm) WRITE ( numond, namsbc_sas ) 197 ! 197 ! 198 198 IF(lwp) THEN ! Control print 199 199 WRITE(numout,*) ' Namelist namsbc_sas' 200 WRITE(numout,*) ' Initialisation using an input file l_sasread = ', l_sasread 200 WRITE(numout,*) ' Initialisation using an input file l_sasread = ', l_sasread 201 201 WRITE(numout,*) ' Are we supplying a 3D u,v and e3 field ln_3d_uve = ', ln_3d_uve 202 202 WRITE(numout,*) ' Are we reading frq (fraction of qsr absorbed in the 1st T level) ln_read_frq = ', ln_read_frq … … 226 226 ln_closea = .false. 227 227 ENDIF 228 229 ! 228 229 ! 230 230 IF( l_sasread ) THEN ! store namelist information in an array 231 ! 231 ! 232 232 !! following code is a bit messy, but distinguishes between when u,v are 3d arrays and 233 233 !! when we have other 3d arrays that we need to read in … … 275 275 ENDIF 276 276 ! 277 ierr1 = 0 ! default definition if slf_?d(ifpr)%ln_tint = .false. 277 ierr1 = 0 ! default definition if slf_?d(ifpr)%ln_tint = .false. 278 278 IF( nfld_3d > 0 ) THEN 279 279 ALLOCATE( sf_ssm_3d(nfld_3d), STAT=ierr ) ! set sf structure … … 282 282 ENDIF 283 283 DO ifpr = 1, nfld_3d 284 284 ALLOCATE( sf_ssm_3d(ifpr)%fnow(jpi,jpj,jpk) , STAT=ierr0 ) 285 285 IF( slf_3d(ifpr)%ln_tint ) ALLOCATE( sf_ssm_3d(ifpr)%fdta(jpi,jpj,jpk,2) , STAT=ierr1 ) 286 286 IF( ierr0 + ierr1 > 0 ) THEN … … 298 298 ENDIF 299 299 DO ifpr = 1, nfld_2d 300 300 ALLOCATE( sf_ssm_2d(ifpr)%fnow(jpi,jpj,1) , STAT=ierr0 ) 301 301 IF( slf_2d(ifpr)%ln_tint ) ALLOCATE( sf_ssm_2d(ifpr)%fdta(jpi,jpj,1,2) , STAT=ierr1 ) 302 302 IF( ierr0 + ierr1 > 0 ) THEN -
NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/SAS/step.F90
r12377 r13159 74 74 !! -2- Outputs and diagnostics 75 75 !!---------------------------------------------------------------------- 76 INTEGER :: indic ! error indicator if < 077 !! ---------------------------------------------------------------------78 76 79 77 #if defined key_agrif 78 IF( nstop > 0 ) RETURN ! avoid to go further if an error was detected during previous time step (child grid) 80 79 kstp = nit000 + Agrif_Nb_Step() 81 80 Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs ! agrif_oce module copies of time level indices 82 IF 83 IF ( Agrif_Root() .and. lwp) Write(*,*) '---'84 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() 85 84 ENDIF 86 87 IF ( kstp == (nit000 + 1) ) lk_agrif_fstep = .FALSE. 88 85 IF( kstp == nit000 + 1 ) lk_agrif_fstep = .FALSE. 89 86 # if defined key_iomput 90 87 IF( Agrif_Nbstepint() == 0 ) CALL iom_swap( cxios_context ) 91 88 # endif 92 89 #endif 93 indic = 0 ! although indic is not changed in stp_ctl94 ! need to keep the same interface95 90 IF( kstp == nit000 ) CALL iom_init( cxios_context ) ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 96 91 IF( kstp /= nit000 ) CALL day( kstp ) ! Calendar (day was already called at nit000 in day_init) … … 109 104 #if defined key_agrif 110 105 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 111 ! AGRIF 106 ! AGRIF recursive integration 112 107 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 113 CALL Agrif_Integrate_ChildGrids( stp ) 108 CALL Agrif_Integrate_ChildGrids( stp ) 109 110 #endif 111 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 112 ! Control 113 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 114 CALL stp_ctl( kstp, Nnn ) 114 115 115 IF( Agrif_NbStepint() == 0 ) THEN ! AGRIF Update from zoom N to zoom 1 then to Parent 116 #if defined key_agrif 117 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 118 ! AGRIF update 119 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 120 IF( Agrif_NbStepint() == 0 .AND. nstop == 0 ) THEN ! AGRIF Update from zoom N to zoom 1 then to Parent 116 121 #if defined key_si3 117 122 CALL Agrif_Update_ice( ) ! update sea-ice 118 123 #endif 119 124 ENDIF 125 120 126 #endif 121 122 127 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 123 ! Control 124 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 125 CALL stp_ctl( kstp, indic ) 126 IF( indic < 0 ) THEN 127 CALL ctl_stop( 'step: indic < 0' ) 128 CALL dia_wri_state( 'output.abort', Nnn ) 129 ENDIF 130 IF( kstp == nit000 ) CALL iom_close( numror ) ! close input ocean restart file 128 ! File manipulation at the end of the first time step 129 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 130 IF( kstp == nit000 ) CALL iom_close( numror ) ! close input ocean restart file 131 131 132 132 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 133 133 ! Coupled mode 134 134 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 135 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 136 136 137 137 #if defined key_iomput … … 144 144 lrst_oce = .FALSE. 145 145 ENDIF 146 IF( kstp == nitend .OR. indic <0 ) THEN147 146 IF( kstp == nitend .OR. nstop > 0 ) THEN 147 CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF 148 148 ENDIF 149 149 #endif -
NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/SAS/stpctl.F90
r12377 r13159 21 21 USE ice , ONLY : vt_i, u_ice, tm_i 22 22 ! 23 USE diawri ! Standard run outputs (dia_wri_state routine) 23 24 USE in_out_manager ! I/O manager 24 25 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 25 26 USE lib_mpp ! distributed memory computing 26 27 ! 27 28 USE netcdf ! NetCDF library 28 29 IMPLICIT NONE … … 31 32 PUBLIC stp_ctl ! routine called by step.F90 32 33 33 INTEGER :: idrun, idtime, idssh, idu, ids, istatus34 LOGICAL :: lsomeoce34 INTEGER :: nrunid ! netcdf file id 35 INTEGER, DIMENSION(3) :: nvarid ! netcdf variable id 35 36 !!---------------------------------------------------------------------- 36 37 !! NEMO/SAS 4.0 , NEMO Consortium (2018) … … 38 39 !! Software governed by the CeCILL license (see ./LICENSE) 39 40 !!---------------------------------------------------------------------- 40 41 41 CONTAINS 42 42 43 SUBROUTINE stp_ctl( kt, kindic)43 SUBROUTINE stp_ctl( kt, Kmm ) 44 44 !!---------------------------------------------------------------------- 45 45 !! *** ROUTINE stp_ctl *** … … 49 49 !! ** Method : - Save the time step in numstp 50 50 !! - Print it each 50 time steps 51 !! - Stop the run IF problem encountered by setting nstop > 0 52 !! Problems checked: ice thickness maximum > 100 m 53 !! ice velocity maximum > 10 m/s 54 !! min ice temperature < -100 degC 51 55 !! 52 56 !! ** Actions : "time.step" file = last ocean time-step 53 57 !! "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 58 !! nstop indicator sheared among all local domain 59 !!---------------------------------------------------------------------- 60 INTEGER, INTENT(in ) :: kt ! ocean time-step index 61 INTEGER, INTENT(in ) :: Kmm ! ocean time level index 62 !! 63 INTEGER :: ji ! dummy loop indices 64 INTEGER :: idtime, istatus 65 INTEGER , DIMENSION(4) :: iareasum, iareamin, iareamax 66 INTEGER , DIMENSION(3,3) :: iloc ! min/max loc indices 67 REAL(wp) :: zzz ! local real 68 REAL(wp), DIMENSION(4) :: zmax, zmaxlocal 69 LOGICAL :: ll_wrtstp, ll_colruns, ll_wrtruns 70 LOGICAL, DIMENSION(jpi,jpj) :: llmsk 71 CHARACTER(len=20) :: clname 72 !!---------------------------------------------------------------------- 73 IF( nstop > 0 .AND. ngrdstop > -1 ) RETURN ! stpctl was already called by a child grid 74 ! 75 ll_wrtstp = ( MOD( kt-nit000, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 76 ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1 77 ll_wrtruns = ( ll_colruns .OR. jpnij == 1 ) .AND. lwm 78 ! 79 IF( kt == nit000 ) THEN 80 ! 81 IF( lwp ) THEN 82 WRITE(numout,*) 83 WRITE(numout,*) 'stp_ctl : time-stepping control' 84 WRITE(numout,*) '~~~~~~~' 85 ENDIF 86 ! ! open time.step ascii file, done only by 1st subdomain 87 IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 88 ! 89 IF( ll_wrtruns ) THEN 90 ! ! open run.stat ascii file, done only by 1st subdomain 76 91 CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 92 ! ! open run.stat.nc netcdf file, done only by 1st subdomain 77 93 clname = 'run.stat.nc' 78 94 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) 95 istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, nrunid ) 96 istatus = NF90_DEF_DIM( nrunid, 'time' , NF90_UNLIMITED, idtime ) 97 istatus = NF90_DEF_VAR( nrunid, 'vt_i_max' , NF90_DOUBLE, (/ idtime /), nvarid(1) ) 98 istatus = NF90_DEF_VAR( nrunid, 'abs_u_max', NF90_DOUBLE, (/ idtime /), nvarid(2) ) 99 istatus = NF90_DEF_VAR( nrunid, 'tm_i_min' , NF90_DOUBLE, (/ idtime /), nvarid(3) ) 100 istatus = NF90_ENDDEF(nrunid) 101 ENDIF 102 ! 103 ENDIF 104 ! 105 ! !== write current time step ==! 106 ! !== done only by 1st subdomain at writting timestep ==! 107 IF( lwm .AND. ll_wrtstp ) THEN 90 108 WRITE ( numstp, '(1x, i8)' ) kt 91 109 REWIND( numstp ) 92 110 ENDIF 93 ! !== test of extrema ==! 111 ! !== test of local extrema ==! 112 ! !== done by all processes at every time step ==! 113 llmsk(:,:) = tmask(:,:,1) == 1._wp 114 IF( COUNT( llmsk(:,:) ) > 0 ) THEN ! avoid huge values sent back for land processors... 115 zmax(1) = MAXVAL( vt_i (:,:) , mask = llmsk ) ! max ice thickness 116 zmax(2) = MAXVAL( ABS( u_ice(:,:) ) , mask = llmsk ) ! max ice velocity (zonal only) 117 zmax(3) = MAXVAL( -tm_i (:,:) + 273.15_wp, mask = llmsk ) ! min ice temperature 118 ELSE 119 IF( ll_colruns ) THEN ! default value: must not be kept when calling mpp_max -> must be as small as possible 120 zmax(1:3) = -HUGE(1._wp) 121 ELSE ! default value: must not give true for any of the tests bellow (-> avoid manipulating HUGE...) 122 zmax(1:3) = 0._wp 123 ENDIF 124 ENDIF 125 zmax(4) = REAL( nstop, wp ) ! stop indicator 126 ! !== get global extrema ==! 127 ! !== done by all processes if writting run.stat ==! 94 128 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 129 zmaxlocal(:) = zmax(:) 130 CALL mpp_max( "stpctl", zmax ) ! max over the global domain 131 nstop = NINT( zmax(4) ) ! update nstop indicator (now sheared among all local domains) 132 ENDIF 133 ! !== write "run.stat" files ==! 134 ! !== done only by 1st subdomain at writting timestep ==! 135 IF( ll_wrtruns ) THEN 136 WRITE(numrun,9500) kt, zmax(1), zmax(2), -zmax(3) 137 istatus = NF90_PUT_VAR( nrunid, nvarid(1), (/ zmax(1)/), (/kt/), (/1/) ) 138 istatus = NF90_PUT_VAR( nrunid, nvarid(2), (/ zmax(2)/), (/kt/), (/1/) ) 139 istatus = NF90_PUT_VAR( nrunid, nvarid(3), (/-zmax(3)/), (/kt/), (/1/) ) 140 IF( kt == nitend ) istatus = NF90_CLOSE(nrunid) 99 141 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 142 ! !== error handling ==! 143 ! !== done by all processes at every time step ==! 144 ! 145 IF( zmax(1) > 100._wp .OR. & ! too large ice thickness maximum ( > 100 m) 146 & zmax(2) > 10._wp .OR. & ! too large ice velocity ( > 10 m/s) 147 & zmax(3) > 101._wp .OR. & ! too cold ice temperature ( < -100 degC) 148 & ISNAN( zmax(1) + zmax(2) + zmax(3) ) .OR. & ! NaN encounter in the tests 149 & ABS( zmax(1) + zmax(2) + zmax(3) ) > HUGE(1._wp) ) THEN ! Infinity encounter in the tests 150 ! 151 iloc(:,:) = 0 152 IF( ll_colruns ) THEN ! zmax is global, so it is the same on all subdomains -> no dead lock with mpp_maxloc 153 ! first: close the netcdf file, so we can read it 154 IF( lwm .AND. kt /= nitend ) istatus = NF90_CLOSE(nrunid) 155 ! get global loc on the min/max 156 CALL mpp_maxloc( 'stpctl', vt_i(:,:) , tmask(:,:,1), zzz, iloc(1:2,1) ) ! mpp_maxloc ok if mask = F 157 CALL mpp_maxloc( 'stpctl',ABS( u_ice(:,:) ) , tmask(:,:,1), zzz, iloc(1:2,2) ) 158 CALL mpp_minloc( 'stpctl', tm_i(:,:) - 273.15_wp, tmask(:,:,1), zzz, iloc(1:2,3) ) 159 ! find which subdomain has the max. 160 iareamin(:) = jpnij+1 ; iareamax(:) = 0 ; iareasum(:) = 0 161 DO ji = 1, 4 162 IF( zmaxlocal(ji) == zmax(ji) ) THEN 163 iareamin(ji) = narea ; iareamax(ji) = narea ; iareasum(ji) = 1 164 ENDIF 165 END DO 166 CALL mpp_min( "stpctl", iareamin ) ! min over the global domain 167 CALL mpp_max( "stpctl", iareamax ) ! max over the global domain 168 CALL mpp_sum( "stpctl", iareasum ) ! sum over the global domain 169 ELSE ! find local min and max locations: 170 ! if we are here, this means that the subdomain contains some oce points -> no need to test the mask used in maxloc 171 iloc(1:2,1) = MAXLOC( vt_i(:,:) , mask = llmsk ) + (/ nimpp - 1, njmpp - 1/) 172 iloc(1:2,2) = MAXLOC( ABS( u_ice(:,:) ) , mask = llmsk ) + (/ nimpp - 1, njmpp - 1/) 173 iloc(1:2,3) = MINLOC( tm_i(:,:) - 273.15_wp, mask = llmsk ) + (/ nimpp - 1, njmpp - 1/) 174 iareamin(:) = narea ; iareamax(:) = narea ; iareasum(:) = 1 ! this is local information 175 ENDIF 176 ! 177 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' 178 CALL wrt_line( ctmp2, kt, 'ice_thick max', zmax(1), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) ) 179 CALL wrt_line( ctmp3, kt, '|ice_vel| max', zmax(2), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) ) 180 CALL wrt_line( ctmp4, kt, 'ice_temp min', -zmax(3), iloc(:,3), iareasum(3), iareamin(3), iareamax(3) ) 181 IF( Agrif_Root() ) THEN 182 WRITE(ctmp6,*) ' ===> output of last computed fields in output.abort* files' 183 ELSE 184 WRITE(ctmp6,*) ' ===> output of last computed fields in '//TRIM(Agrif_CFixed())//'_output.abort* files' 185 ENDIF 186 ! 187 CALL dia_wri_state( Kmm, 'output.abort' ) ! create an output.abort file 188 ! 189 IF( ll_colruns .or. jpnij == 1 ) THEN ! all processes synchronized -> use lwp to print in opened ocean.output files 190 IF(lwp) THEN ; CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 191 ELSE ; nstop = MAX(1, nstop) ! make sure nstop > 0 (automatically done when calling ctl_stop) 192 ENDIF 193 ELSE ! only mpi subdomains with errors are here -> STOP now 194 CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 195 ENDIF 196 ! 197 ENDIF 198 ! 199 IF( nstop > 0 ) THEN ! an error was detected and we did not abort yet... 200 ngrdstop = Agrif_Fixed() ! store which grid got this error 201 IF( .NOT. ll_colruns .AND. jpnij > 1 ) CALL ctl_stop( 'STOP' ) ! we must abort here to avoid MPI deadlock 202 ENDIF 109 203 ! 110 204 9500 FORMAT(' it :', i8, ' vt_i_max: ', D23.16, ' |u|_max: ', D23.16,' tm_i_min: ', D23.16) 111 205 ! 112 206 END SUBROUTINE stp_ctl 207 208 209 SUBROUTINE wrt_line( cdline, kt, cdprefix, pval, kloc, ksum, kmin, kmax ) 210 !!---------------------------------------------------------------------- 211 !! *** ROUTINE wrt_line *** 212 !! 213 !! ** Purpose : write information line 214 !! 215 !!---------------------------------------------------------------------- 216 CHARACTER(len=*), INTENT( out) :: cdline 217 CHARACTER(len=*), INTENT(in ) :: cdprefix 218 REAL(wp), INTENT(in ) :: pval 219 INTEGER, DIMENSION(3), INTENT(in ) :: kloc 220 INTEGER, INTENT(in ) :: kt, ksum, kmin, kmax 221 ! 222 CHARACTER(len=80) :: clsuff 223 CHARACTER(len=9 ) :: clkt, clsum, clmin, clmax 224 CHARACTER(len=9 ) :: cli, clj, clk 225 CHARACTER(len=1 ) :: clfmt 226 CHARACTER(len=4 ) :: cl4 ! needed to be able to compile with Agrif, I don't know why 227 INTEGER :: ifmtk 228 !!---------------------------------------------------------------------- 229 WRITE(clkt , '(i9)') kt 230 231 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpnij ,wp))) + 1 ! how many digits to we need to write ? (we decide max = 9) 232 !!! WRITE(clsum, '(i'//clfmt//')') ksum ! this is creating a compilation error with AGRIF 233 cl4 = '(i'//clfmt//')' ; WRITE(clsum, cl4) ksum 234 WRITE(clfmt, '(i1)') INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1 ! how many digits to we need to write ? (we decide max = 9) 235 cl4 = '(i'//clfmt//')' ; WRITE(clmin, cl4) kmin-1 236 WRITE(clmax, cl4) kmax-1 237 ! 238 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpiglo,wp))) + 1 ! how many digits to we need to write jpiglo? (we decide max = 9) 239 cl4 = '(i'//clfmt//')' ; WRITE(cli, cl4) kloc(1) ! this is ok with AGRIF 240 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpjglo,wp))) + 1 ! how many digits to we need to write jpjglo? (we decide max = 9) 241 cl4 = '(i'//clfmt//')' ; WRITE(clj, cl4) kloc(2) ! this is ok with AGRIF 242 ! 243 IF( ksum == 1 ) THEN ; WRITE(clsuff,9100) TRIM(clmin) 244 ELSE ; WRITE(clsuff,9200) TRIM(clsum), TRIM(clmin), TRIM(clmax) 245 ENDIF 246 IF(kloc(3) == 0) THEN 247 ifmtk = INT(LOG10(REAL(jpk,wp))) + 1 ! how many digits to we need to write jpk? (we decide max = 9) 248 clk = REPEAT(' ', ifmtk) ! create the equivalent in blank string 249 WRITE(cdline,9300) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj), clk(1:ifmtk), TRIM(clsuff) 250 ELSE 251 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpk,wp))) + 1 ! how many digits to we need to write jpk? (we decide max = 9) 252 !!! WRITE(clk, '(i'//clfmt//')') kloc(3) ! this is creating a compilation error with AGRIF 253 cl4 = '(i'//clfmt//')' ; WRITE(clk, cl4) kloc(3) ! this is ok with AGRIF 254 WRITE(cdline,9400) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj), TRIM(clk), TRIM(clsuff) 255 ENDIF 256 ! 257 9100 FORMAT('MPI rank ', a) 258 9200 FORMAT('found in ', a, ' MPI tasks, spread out among ranks ', a, ' to ', a) 259 9300 FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j ', a, ' ', a, ' ', a, ' ', a) 260 9400 FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j k ', a, ' ', a, ' ', a, ' ', a) 261 ! 262 END SUBROUTINE wrt_line 263 113 264 114 265 !!======================================================================
Note: See TracChangeset
for help on using the changeset viewer.
