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.

isfstp.F90 in NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/ISF – NEMO

Context Navigation

source: NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/ISF/isfstp.F90 @ 14219

Last change on this file since 14219 was 14219, checked in by mcastril, 3 years ago
Add Mixed Precision support by Oriol Tintó
Property svn:keywords set to `Id`
File size: 15.4 KB

Rev	Line
[11403]	1	MODULE isfstp
[4666]	2	!!======================================================================
[11403]	3	!! * MODULE isfstp *
[14064]	4	!! Ice Shelves : compute iceshelf load, melt and heat flux
[4666]	5	!!======================================================================
[9019]	6	!! History : 3.2 ! 2011-02 (C.Harris ) Original code isf cav
	7	!! X.X ! 2006-02 (C. Wang ) Original code bg03
	8	!! 3.4 ! 2013-03 (P. Mathiot) Merging + parametrization
[11395]	9	!! 4.1 ! 2019-09 (P. Mathiot) Split param/explicit ice shelf and re-organisation
[4666]	10	!!----------------------------------------------------------------------
	11
	12	!!----------------------------------------------------------------------
[11403]	13	!! isfstp : compute iceshelf melt and heat flux
[4666]	14	!!----------------------------------------------------------------------
[12077]	15	USE isf_oce ! isf variables
[11852]	16	USE isfload, ONLY: isf_load ! ice shelf load
	17	USE isftbl , ONLY: isf_tbl_lvl ! ice shelf boundary layer
	18	USE isfpar , ONLY: isf_par, isf_par_init ! ice shelf parametrisation
	19	USE isfcav , ONLY: isf_cav, isf_cav_init ! ice shelf cavity
	20	USE isfcpl , ONLY: isfcpl_rst_write, isfcpl_init ! isf variables
[4666]	21
[13237]	22	USE dom_oce ! ocean space and time domain
	23	USE oce , ONLY: ssh ! sea surface height
[11852]	24	USE domvvl, ONLY: ln_vvl_zstar ! zstar logical
	25	USE zdfdrg, ONLY: r_Cdmin_top, r_ke0_top ! vertical physics: top/bottom drag coef.
	26	!
	27	USE lib_mpp, ONLY: ctl_stop, ctl_nam
[11931]	28	USE fldread, ONLY: FLD, FLD_N
[11852]	29	USE in_out_manager ! I/O manager
[11876]	30	USE timing
[11852]	31
[4666]	32	IMPLICIT NONE
	33	PRIVATE
	34
[11553]	35	PUBLIC isf_stp, isf_init, isf_nam ! routine called in sbcmod and divhor
[4666]	36
[13237]	37	!! * Substitutions
	38	# include "domzgr_substitute.h90"
[14219]	39	# include "single_precision_substitute.h90"
[4666]	40	!!----------------------------------------------------------------------
[9598]	41	!! NEMO/OCE 4.0 , NEMO Consortium (2018)
[5215]	42	!! $Id$
[10068]	43	!! Software governed by the CeCILL license (see ./LICENSE)
[4666]	44	!!----------------------------------------------------------------------
	45	CONTAINS
	46
[14064]	47	SUBROUTINE isf_stp( kt, Kmm )
[5836]	48	!!---------------------------------------------------------------------
[11403]	49	!! * ROUTINE isf_stp *
[6140]	50	!!
[11403]	51	!! ** Purpose : compute total heat flux and total fwf due to ice shelf melt
[6140]	52	!!
[11403]	53	!! ** Method : For each case (parametrisation or explicity cavity) :
	54	!! - define the before fields
	55	!! - compute top boundary layer properties
	56	!! (in case of parametrisation, this is the
	57	!! depth range model array used to compute mean far fields properties)
	58	!! - compute fluxes
	59	!! - write restart variables
[6140]	60	!!----------------------------------------------------------------------
[14064]	61	INTEGER, INTENT(in) :: kt ! ocean time step
	62	INTEGER, INTENT(in) :: Kmm ! ocean time level index
	63	!
	64	INTEGER :: jk ! loop index
	65	#if defined key_qco
	66	REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t ! 3D workspace
	67	#endif
[4666]	68	!!---------------------------------------------------------------------
	69	!
[11876]	70	IF( ln_timing ) CALL timing_start('isf')
	71	!
[11931]	72	!=======================================================================
	73	! 1.: compute melt and associated heat fluxes in the ice shelf cavities
	74	!=======================================================================
	75	!
[11395]	76	IF ( ln_isfcav_mlt ) THEN
[9019]	77	!
[11931]	78	! 1.1: before time step
[11395]	79	IF ( kt /= nit000 ) THEN
	80	risf_cav_tsc_b (:,:,:) = risf_cav_tsc (:,:,:)
	81	fwfisf_cav_b(:,:) = fwfisf_cav(:,:)
	82	END IF
[7788]	83	!
[11931]	84	! 1.2: compute misfkb, rhisf_tbl, rfrac (deepest level, thickness, fraction of deepest cell affected by tbl)
[11541]	85	rhisf_tbl_cav(:,:) = rn_htbl * mskisf_cav(:,:)
[14064]	86	#if defined key_qco
[13237]	87	DO jk = 1, jpk
	88	ze3t(:,:,jk) = e3t(:,:,jk,Kmm)
	89	END DO
[14200]	90	CALL isf_tbl_lvl( ht(:,:), ze3t , misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav )
[14064]	91	#else
[14219]	92	CALL isf_tbl_lvl( ht(:,:), CASTWP(e3t(:,:,:,Kmm)), misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav )
[14064]	93	#endif
[11395]	94	!
[11931]	95	! 1.3: compute ice shelf melt
[14064]	96	CALL isf_cav( kt, Kmm, risf_cav_tsc, fwfisf_cav )
[11395]	97	!
	98	END IF
[9019]	99	!
[11931]	100	!=================================================================================
	101	! 2.: compute melt and associated heat fluxes for not resolved ice shelf cavities
	102	!=================================================================================
	103	!
[11395]	104	IF ( ln_isfpar_mlt ) THEN
[4666]	105	!
[11931]	106	! 2.1: before time step
[11395]	107	IF ( kt /= nit000 ) THEN
[11423]	108	risf_par_tsc_b(:,:,:) = risf_par_tsc(:,:,:)
	109	fwfisf_par_b (:,:) = fwfisf_par (:,:)
[11395]	110	END IF
[4666]	111	!
[11931]	112	! 2.2: compute misfkb, rhisf_tbl, rfrac (deepest level, thickness, fraction of deepest cell affected by tbl)
	113	! by simplicity, we assume the top level where param applied do not change with time (done in init part)
[11541]	114	rhisf_tbl_par(:,:) = rhisf0_tbl_par(:,:)
[14064]	115	#if defined key_qco
[13237]	116	DO jk = 1, jpk
	117	ze3t(:,:,jk) = e3t(:,:,jk,Kmm)
	118	END DO
[14200]	119	CALL isf_tbl_lvl( ht(:,:), ze3t , misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par )
[14064]	120	#else
[14219]	121	CALL isf_tbl_lvl( ht(:,:), CASTWP(e3t(:,:,:,Kmm)), misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par )
[14064]	122	#endif
[11395]	123	!
[11931]	124	! 2.3: compute ice shelf melt
[14064]	125	CALL isf_par( kt, Kmm, risf_par_tsc, fwfisf_par )
[11395]	126	!
	127	END IF
	128	!
[11931]	129	!==================================================================================
	130	! 3.: output specific restart variable in case of coupling with an ice sheet model
	131	!==================================================================================
	132	!
[12068]	133	IF ( ln_isfcpl .AND. lrst_oce ) CALL isfcpl_rst_write(kt, Kmm)
[11852]	134	!
[11876]	135	IF( ln_timing ) CALL timing_stop('isf')
	136	!
[11403]	137	END SUBROUTINE isf_stp
[4666]	138
[14064]	139
	140	SUBROUTINE isf_init( Kbb, Kmm, Kaa )
[6140]	141	!!---------------------------------------------------------------------
[11403]	142	!! * ROUTINE isfstp_init *
[6140]	143	!!
[11403]	144	!! ** Purpose : Initialisation of the ice shelf public variables
[6140]	145	!!
[11823]	146	!! ** Method : Read the namisf namelist, check option compatibility and set derived parameters
[11395]	147	!!
[11823]	148	!! ** Action : - read namisf parameters
[11403]	149	!! - allocate memory
[11823]	150	!! - output print
	151	!! - ckeck option compatibility
	152	!! - call cav/param/isfcpl init routine
[5836]	153	!!----------------------------------------------------------------------
[14064]	154	INTEGER, INTENT(in) :: Kbb, Kmm, Kaa ! ocean time level indices
	155	!!----------------------------------------------------------------------
[11403]	156	!
[11553]	157	! constrain: l_isfoasis need to be known
	158	!
[14064]	159	CALL isf_nam() ! Read namelist
[11553]	160	!
[14064]	161	CALL isf_alloc() ! Allocate public array
[11403]	162	!
[14064]	163	CALL isf_ctl() ! check option compatibility
[11403]	164	!
[14064]	165	IF( ln_isfcav ) CALL isf_load( Kmm, risfload ) ! compute ice shelf load
[11403]	166	!
[11553]	167	! terminate routine now if no ice shelf melt formulation specify
[14064]	168	IF( ln_isf ) THEN
[11553]	169	!
[14064]	170	IF( ln_isfcav_mlt ) CALL isf_cav_init() ! initialisation melt in the cavity
[11553]	171	!
[14064]	172	IF( ln_isfpar_mlt ) CALL isf_par_init() ! initialisation parametrised melt
[11553]	173	!
[14064]	174	IF( ln_isfcpl ) CALL isfcpl_init( Kbb, Kmm, Kaa ) ! initialisation ice sheet coupling
[11852]	175	!
[11553]	176	END IF
	177
	178	END SUBROUTINE isf_init
	179
[14064]	180
[11823]	181	SUBROUTINE isf_ctl()
	182	!!---------------------------------------------------------------------
	183	!! * ROUTINE isf_ctl *
	184	!!
	185	!! ** Purpose : output print and option compatibility check
	186	!!
	187	!!----------------------------------------------------------------------
[11423]	188	IF (lwp) THEN
	189	WRITE(numout,*)
	190	WRITE(numout,*) 'isf_init : ice shelf initialisation'
	191	WRITE(numout,*) '~~~~~~~~~~~~'
	192	WRITE(numout,*) ' Namelist namisf :'
	193	!
[11489]	194	WRITE(numout,*) ' ice shelf cavity (open or parametrised) ln_isf = ', ln_isf
[11553]	195	WRITE(numout,*)
[11489]	196	!
	197	IF ( ln_isf ) THEN
[11876]	198	WRITE(numout,*) ' Add debug print in isf module ln_isfdebug = ', ln_isfdebug
	199	WRITE(numout,*)
[11489]	200	WRITE(numout,*) ' melt inside the cavity ln_isfcav_mlt = ', ln_isfcav_mlt
[11541]	201	IF ( ln_isfcav_mlt) THEN
[12077]	202	WRITE(numout,*) ' melt formulation cn_isfcav_mlt= ', TRIM(cn_isfcav_mlt)
	203	WRITE(numout,*) ' thickness of the top boundary layer rn_htbl = ', rn_htbl
	204	WRITE(numout,*) ' gamma formulation cn_gammablk = ', TRIM(cn_gammablk)
[11489]	205	IF ( TRIM(cn_gammablk) .NE. 'spe' ) THEN
[12077]	206	WRITE(numout,*) ' gammat coefficient rn_gammat0 = ', rn_gammat0
	207	WRITE(numout,*) ' gammas coefficient rn_gammas0 = ', rn_gammas0
	208	WRITE(numout,*) ' top background ke used (from namdrg_top) rn_ke0 = ', r_ke0_top
	209	WRITE(numout,*) ' top drag coef. used (from namdrg_top) rn_Cd0 = ', r_Cdmin_top
[11489]	210	END IF
[11423]	211	END IF
[11489]	212	WRITE(numout,*) ''
	213	!
[11553]	214	WRITE(numout,*) ' ice shelf melt parametrisation ln_isfpar_mlt = ', ln_isfpar_mlt
[11489]	215	IF ( ln_isfpar_mlt ) THEN
	216	WRITE(numout,*) ' isf parametrisation formulation cn_isfpar_mlt = ', TRIM(cn_isfpar_mlt)
	217	END IF
	218	WRITE(numout,*) ''
	219	!
[11553]	220	WRITE(numout,*) ' Coupling to an ice sheet model ln_isfcpl = ', ln_isfcpl
[11541]	221	IF ( ln_isfcpl ) THEN
[11553]	222	WRITE(numout,*) ' conservation activated ln_isfcpl_cons = ', ln_isfcpl_cons
	223	WRITE(numout,*) ' number of call of the extrapolation loop = ', nn_drown
[11541]	224	ENDIF
	225	WRITE(numout,*) ''
	226	!
[11489]	227	ELSE
[11876]	228	!
[11489]	229	IF ( ln_isfcav ) THEN
	230	WRITE(numout,*) ''
	231	WRITE(numout,*) ' W A R N I N G: ice shelf cavities are open BUT no melt will be computed or read from file !'
	232	WRITE(numout,*) ''
	233	END IF
[11876]	234	!
[6140]	235	END IF
[11489]	236
[12077]	237	IF (ln_isfcav) THEN
	238	WRITE(numout,*) ' Ice shelf load method cn_isfload = ', TRIM(cn_isfload)
	239	WRITE(numout,*) ' Temperature used to compute the ice shelf load = ', rn_isfload_T
	240	WRITE(numout,*) ' Salinity used to compute the ice shelf load = ', rn_isfload_S
	241	END IF
[11521]	242	WRITE(numout,*) ''
[12077]	243	FLUSH(numout)
[11521]	244
[11489]	245	END IF
	246	!
[11553]	247
[11489]	248	!---------------------------------------------------------------------------------------------------------------------
[11553]	249	! sanity check ! issue ln_isfcav not yet known as well as l_isfoasis => move this call in isf_stp ?
[11403]	250	! melt in the cavity without cavity
[11876]	251	IF ( ln_isfcav_mlt .AND. (.NOT. ln_isfcav) ) &
[11553]	252	& CALL ctl_stop('ice shelf melt in the cavity activated (ln_isfcav_mlt) but no cavity detected in domcfg (ln_isfcav), STOP' )
[6140]	253	!
[11489]	254	! ice sheet coupling without cavity
	255	IF ( ln_isfcpl .AND. (.NOT. ln_isfcav) ) &
	256	& CALL ctl_stop('coupling with an ice sheet model detected (ln_isfcpl) but no cavity detected in domcfg (ln_isfcav), STOP' )
	257	!
[11423]	258	IF ( ln_isfcpl .AND. ln_isfcpl_cons .AND. ln_linssh ) &
	259	& CALL ctl_stop( 'The coupling between NEMO and an ice sheet model with the conservation option does not work with the linssh option' )
	260	!
[11553]	261	IF ( l_isfoasis .AND. .NOT. ln_isf ) CALL ctl_stop( ' OASIS send ice shelf fluxes to NEMO but NEMO does not have the isf module activated' )
	262	!
	263	IF ( l_isfoasis .AND. ln_isf ) THEN
[11403]	264	!
[12242]	265	CALL ctl_stop( 'namelist combination ln_cpl and ln_isf not tested' )
[11403]	266	!
	267	! NEMO coupled to ATMO model with isf cavity need oasis method for melt computation
[11423]	268	IF ( ln_isfcav_mlt .AND. TRIM(cn_isfcav_mlt) /= 'oasis' ) CALL ctl_stop( 'cn_isfcav_mlt = oasis is the only option availble if fwf send by oasis' )
	269	IF ( ln_isfpar_mlt .AND. TRIM(cn_isfpar_mlt) /= 'oasis' ) CALL ctl_stop( 'cn_isfpar_mlt = oasis is the only option availble if fwf send by oasis' )
[11403]	270	!
	271	! oasis melt computation not tested (coded but not tested)
	272	IF ( ln_isfcav_mlt .OR. ln_isfpar_mlt ) THEN
	273	IF ( TRIM(cn_isfcav_mlt) == 'oasis' ) CALL ctl_stop( 'cn_isfcav_mlt = oasis not tested' )
	274	IF ( TRIM(cn_isfpar_mlt) == 'oasis' ) CALL ctl_stop( 'cn_isfpar_mlt = oasis not tested' )
	275	END IF
	276	!
	277	! oasis melt computation with cavity open and cavity parametrised (not coded)
	278	IF ( ln_isfcav_mlt .AND. ln_isfpar_mlt ) THEN
	279	IF ( TRIM(cn_isfpar_mlt) == 'oasis' .AND. TRIM(cn_isfcav_mlt) == 'oasis' ) CALL ctl_stop( 'cn_isfpar_mlt = oasis and cn_isfcav_mlt = oasis not coded' )
	280	END IF
[11553]	281	!
[11823]	282	! compatibility ice shelf and vvl
	283	IF( .NOT. ln_vvl_zstar .AND. ln_isf ) CALL ctl_stop( 'Only vvl_zstar has been tested with ice shelf cavity' )
	284	!
[11403]	285	END IF
[11553]	286	END SUBROUTINE isf_ctl
[14064]	287
	288
[11553]	289	SUBROUTINE isf_nam
	290	!!---------------------------------------------------------------------
	291	!! * ROUTINE isf_nam *
	292	!!
	293	!! ** Purpose : Read ice shelf namelist cfg and ref
	294	!!
	295	!!----------------------------------------------------------------------
	296	INTEGER :: ios ! Local integer output status for namelist read
	297	!!----------------------------------------------------------------------
[12077]	298	NAMELIST/namisf/ ln_isf , &
	299	& cn_gammablk , rn_gammat0 , rn_gammas0 , rn_htbl, sn_isfcav_fwf, &
	300	& ln_isfcav_mlt , cn_isfcav_mlt , sn_isfcav_fwf , &
	301	& ln_isfpar_mlt , cn_isfpar_mlt , sn_isfpar_fwf , &
	302	& sn_isfpar_zmin, sn_isfpar_zmax, sn_isfpar_Leff, &
	303	& ln_isfcpl , nn_drown , ln_isfcpl_cons, ln_isfdebug, &
	304	& cn_isfload , rn_isfload_T , rn_isfload_S , cn_isfdir
[11553]	305	!!----------------------------------------------------------------------
[9019]	306	!
[11553]	307	READ ( numnam_ref, namisf, IOSTAT = ios, ERR = 901)
[12068]	308	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namisf in reference namelist' )
[11553]	309	!
	310	READ ( numnam_cfg, namisf, IOSTAT = ios, ERR = 902 )
[12068]	311	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namisf in configuration namelist' )
[11553]	312	IF(lwm) WRITE ( numond, namisf )
	313
	314	END SUBROUTINE isf_nam
	315	!!
[6140]	316	!!======================================================================
[11403]	317	END MODULE isfstp

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

Download in other formats: