New URL for NEMO forge! http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.

stpctl.F90 in NEMO/branches/2020/r12581_ticket2418/tests/STATION_ASF/MY_SRC – NEMO

Context Navigation

source: NEMO/branches/2020/r12581_ticket2418/tests/STATION_ASF/MY_SRC/stpctl.F90 @ 12704

Last change on this file since 12704 was 12704, checked in by laurent, 4 years ago
Fixes so STATION_ASF works fine!
File size: 10.9 KB

Rev	Line
[11930]	1	MODULE stpctl
	2	!!======================================================================
	3	!! * MODULE stpctl *
	4	!! Ocean run control : gross check of the ocean time stepping
	5	!! version for STATION_ASF test-case
	6	!!======================================================================
	7	!! History : OPA ! 1991-03 (G. Madec) Original code
	8	!! 6.0 ! 1992-06 (M. Imbard)
	9	!! 8.0 ! 1997-06 (A.M. Treguier)
	10	!! NEMO 1.0 ! 2002-06 (G. Madec) F90: Free form and module
	11	!! 2.0 ! 2009-07 (G. Madec) Add statistic for time-spliting
	12	!! 3.7 ! 2016-09 (G. Madec) Remove solver
	13	!! 4.0 ! 2017-04 (G. Madec) regroup global communications
	14	!!----------------------------------------------------------------------
	15
	16	!!----------------------------------------------------------------------
	17	!! stp_ctl : Control the run
	18	!!----------------------------------------------------------------------
	19	USE dom_oce ! ocean space and time domain variables
	20	USE sbc_oce ! surface fluxes and stuff
[12685]	21	!
[12249]	22	USE diawri ! Standard run outputs (dia_wri_state routine)
[11930]	23	USE in_out_manager ! I/O manager
	24	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
	25	USE lib_mpp ! distributed memory computing
[12685]	26	!
[11930]	27	USE netcdf ! NetCDF library
	28	IMPLICIT NONE
	29	PRIVATE
	30
	31	PUBLIC stp_ctl ! routine called by step.F90
	32
[12685]	33	INTEGER :: nrunid ! netcdf file id
	34	INTEGER, DIMENSION(3) :: nvarid ! netcdf variable id
[11930]	35	!!----------------------------------------------------------------------
	36	!! NEMO/SAS 4.0 , NEMO Consortium (2018)
	37	!! $Id: stpctl.F90 10603 2019-01-29 11:18:09Z acc $
	38	!! Software governed by the CeCILL license (see ./LICENSE)
	39	!!----------------------------------------------------------------------
	40	CONTAINS
	41
[12685]	42	SUBROUTINE stp_ctl( kt, Kmm )
[11930]	43	!!----------------------------------------------------------------------
	44	!! * ROUTINE stp_ctl *
[12685]	45	!!
[11930]	46	!! ** Purpose : Control the run
	47	!!
	48	!! ** Method : - Save the time step in numstp
	49	!! - Print it each 50 time steps
[12685]	50	!! - Stop the run IF problem encountered by setting nstop > 0
	51	!! Problems checked: wind stress module max larger than 5 N/m^2
	52	!! non-solar heat flux max larger than 2000 W/m^2
	53	!! Evaporation-Precip max larger than 1.E-3 kg/m^2/s
[11930]	54	!!
	55	!! ** Actions : "time.step" file = last ocean time-step
	56	!! "run.stat" file = run statistics
[12685]	57	!! nstop indicator sheared among all local domain
[11930]	58	!!----------------------------------------------------------------------
	59	INTEGER, INTENT(in ) :: kt ! ocean time-step index
[12685]	60	INTEGER, INTENT(in ) :: Kmm ! ocean time level index
[11930]	61	!!
[12685]	62	INTEGER :: ji ! dummy loop indices
	63	INTEGER :: idtime, istatus
	64	INTEGER, DIMENSION(2,3) :: iloc ! min/max loc indices
	65	REAL(wp) :: zzz ! local real
	66	REAL(wp), DIMENSION(4) :: zmax, zmaxlocal, zarea
	67	LOGICAL :: ll_wrtstp, ll_colruns, ll_wrtruns
	68	LOGICAL, DIMENSION(jpi,jpj) :: llmsk
	69	CHARACTER(len=20) :: clname
[11930]	70	!!----------------------------------------------------------------------
[12685]	71	IF( nstop > 0 .AND. ngrdstop > -1 ) RETURN ! stpctl was already called by a child grid
[11930]	72	!
[12593]	73	ll_wrtstp = ( MOD( kt-nit000, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend )
[12685]	74	ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1
	75	ll_wrtruns = ( ll_colruns .OR. jpnij == 1 ) .AND. lwm
[12593]	76	!
	77	IF( kt == nit000 ) THEN
	78	!
	79	IF( lwp ) THEN
	80	WRITE(numout,*)
	81	WRITE(numout,*) 'stp_ctl : time-stepping control'
	82	WRITE(numout,*) '~~~~~~~'
	83	ENDIF
	84	! ! open time.step ascii file, done only by 1st subdomain
	85	IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
	86	!
	87	IF( ll_wrtruns ) THEN
	88	! ! open run.stat ascii file, done only by 1st subdomain
[11930]	89	CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
[12593]	90	! ! open run.stat.nc netcdf file, done only by 1st subdomain
[11930]	91	clname = 'run.stat.nc'
	92	IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname)
[12593]	93	istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, nrunid )
	94	istatus = NF90_DEF_DIM( nrunid, 'time', NF90_UNLIMITED, idtime )
[12685]	95	istatus = NF90_DEF_VAR( nrunid, 'tau_max', NF90_DOUBLE, (/ idtime /), nvarid(1) )
	96	istatus = NF90_DEF_VAR( nrunid, 'qns_max', NF90_DOUBLE, (/ idtime /), nvarid(2) )
	97	istatus = NF90_DEF_VAR( nrunid, 'emp_max', NF90_DOUBLE, (/ idtime /), nvarid(3) )
[12593]	98	istatus = NF90_ENDDEF(nrunid)
[11930]	99	ENDIF
[12593]	100	!
[11930]	101	ENDIF
	102	!
[12593]	103	! !== write current time step ==!
	104	! !== done only by 1st subdomain at writting timestep ==!
	105	IF( lwm .AND. ll_wrtstp ) THEN
[11930]	106	WRITE ( numstp, '(1x, i8)' ) kt
	107	REWIND( numstp )
	108	ENDIF
[12593]	109	! !== test of local extrema ==!
	110	! !== done by all processes at every time step ==!
	111	llmsk(:,:) = tmask(:,:,1) == 1._wp
	112	zmax(1) = MAXVAL( taum(:,:) , mask = llmsk ) ! max wind stress module
	113	zmax(2) = MAXVAL( ABS( qns(:,:) ) , mask = llmsk ) ! max non-solar heat flux
	114	zmax(3) = MAXVAL( ABS( emp(:,:) ) , mask = llmsk ) ! max E-P
[12685]	115	zmax(4) = REAL( nstop, wp ) ! stop indicator
	116	! !== get global extrema ==!
	117	! !== done by all processes if writting run.stat ==!
[11930]	118	IF( ll_colruns ) THEN
[12685]	119	zmaxlocal(:) = zmax(:)
[11930]	120	CALL mpp_max( "stpctl", zmax ) ! max over the global domain
[12685]	121	nstop = NINT( zmax(4) ) ! update nstop indicator (now sheared among all local domains)
[11930]	122	ENDIF
[12685]	123	! !== write "run.stat" files ==!
	124	! !== done only by 1st subdomain at writting timestep ==!
[11930]	125	IF( ll_wrtruns ) THEN
	126	WRITE(numrun,9500) kt, zmax(1), zmax(2), zmax(3)
[12685]	127	istatus = NF90_PUT_VAR( nrunid, nvarid(1), (/ zmax(1)/), (/kt/), (/1/) )
	128	istatus = NF90_PUT_VAR( nrunid, nvarid(2), (/ zmax(2)/), (/kt/), (/1/) )
	129	istatus = NF90_PUT_VAR( nrunid, nvarid(3), (/ zmax(3)/), (/kt/), (/1/) )
	130	IF( kt == nitend ) istatus = NF90_CLOSE(nrunid)
[11930]	131	END IF
[12685]	132	! !== error handling ==!
	133	! !== done by all processes at every time step ==!
	134	!
	135	IF( zmax(1) > 5._wp .OR. & ! too large wind stress ( > 5 N/m^2 )
	136	& zmax(2) > 2000._wp .OR. & ! too large non-solar heat flux ( > 2000 W/m^2 )
	137	& zmax(3) > 1.E-3_wp .OR. & ! too large net freshwater flux ( > 1.E-3 kg/m^2/s )
	138	& ISNAN( zmax(1) + zmax(2) + zmax(3) ) ) THEN ! NaN encounter in the tests
	139	!
	140	IF( ll_colruns ) THEN ! zmax is global, so it is the same on all subdomains -> no dead lock with mpp_maxloc
	141	! first: close the netcdf file, so we can read it
	142	IF( lwm .AND. kt /= nitend ) istatus = NF90_CLOSE(nrunid)
	143	! get global loc on the min/max
[12704]	144	CALL mpp_maxloc( 'stpctl', taum(:,:) , tmask(:,:,1), zzz, iloc(1:2,1) ) ! mpp_maxloc ok if mask = F
	145	CALL mpp_maxloc( 'stpctl',ABS( qns(:,:) ) , tmask(:,:,1), zzz, iloc(1:2,2) )
	146	CALL mpp_minloc( 'stpctl', emp(:,:) - 273.15_wp, tmask(:,:,1), zzz, iloc(1:2,3) )
[12685]	147	! find which subdomain has the max.
	148	zarea(:) = 0._wp
	149	DO ji = 1, 4
	150	IF( zmaxlocal(ji) == zmax(ji) ) zarea(ji) = narea
	151	END DO
	152	CALL mpp_max( "stpctl", zarea ) ! max over the global domain
	153	ELSE ! find local min and max locations:
	154	! if we are here, this means that the subdomain contains some oce points -> no need to test the mask used in maxloc
[12704]	155	iloc(1:2,1) = MAXLOC( taum(:,:) , mask = llmsk ) + (/ nimpp - 1, njmpp - 1/)
	156	iloc(1:2,2) = MAXLOC( ABS( qns(:,:) ) , mask = llmsk ) + (/ nimpp - 1, njmpp - 1/)
	157	iloc(1:2,3) = MINLOC( emp(:,:) - 273.15_wp, mask = llmsk ) + (/ nimpp - 1, njmpp - 1/)
[12685]	158	zarea(:) = narea ! this is local information
	159	ENDIF
	160	!
[11930]	161	WRITE(ctmp1,*) ' stp_ctl: \|tau_mod\| > 5 N/m2 or \|qns\| > 2000 W/m2 or \|emp\| > 1.E-3 or NaN encounter in the tests'
[12685]	162	WRITE(ctmp2,9100) kt, ' \|tau\| max', zmax(1), iloc(1,1), iloc(2,1), NINT(zarea(1))-1
	163	WRITE(ctmp3,9100) kt, ' \|qns\| max', zmax(2), iloc(1,2), iloc(2,3), NINT(zarea(2))-1
	164	WRITE(ctmp4,9100) kt, ' emp max', zmax(3), iloc(1,2), iloc(2,3), NINT(zarea(3))-1
	165	IF( Agrif_Root() ) THEN
	166	WRITE(ctmp6,) ' ===> output of last computed fields in output.abort files'
[11930]	167	ELSE
[12685]	168	WRITE(ctmp6,) ' ===> output of last computed fields in '//TRIM(Agrif_CFixed())//'_output.abort files'
[11930]	169	ENDIF
	170	!
[12685]	171	CALL dia_wri_state( Kmm, 'output.abort' ) ! create an output.abort file
	172	!
	173	IF( ll_colruns .or. jpnij == 1 ) THEN ! all processes synchronized -> use lwp to print in opened ocean.output files
	174	IF(lwp) CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 )
	175	ELSE ! only mpi subdomains with errors are here -> STOP now
	176	CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 )
	177	ENDIF
	178	!
	179	IF( nstop == 0 ) nstop = 1
	180	ngrdstop = Agrif_Fixed()
	181	!
[11930]	182	ENDIF
	183	!
[12685]	184	9100 FORMAT(' kt ',i8,a,1pg11.4,' at i j',2i6,' MPI rank',i6)
[11930]	185	9500 FORMAT(' it :', i8, ' tau_max: ', D23.16, ' \|qns\|_max: ', D23.16,' \|emp\|_max: ', D23.16)
	186	!
	187	END SUBROUTINE stp_ctl
	188
	189	!!======================================================================
	190	END MODULE stpctl

Note: See TracBrowser for help on using the repository browser.

Download in other formats: