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.

sbcssr.F90 in trunk/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

Context Navigation

source: trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90 @ 3294

Last change on this file since 3294 was 3294, checked in by rblod, 12 years ago
Merge of 3.4beta into the trunk
Property svn:keywords set to `Id`
File size: 11.4 KB

Rev	Line
[888]	1	MODULE sbcssr
	2	!!======================================================================
	3	!! * MODULE sbcssr *
[1524]	4	!! Surface module : heat and fresh water fluxes a restoring term toward observed SST/SSS
[888]	5	!!======================================================================
[1524]	6	!! History : 3.0 ! 2006-06 (G. Madec) Original code
[1482]	7	!! 3.2 ! 2009-04 (B. Lemaire) Introduce iom_put
[888]	8	!!----------------------------------------------------------------------
	9
	10	!!----------------------------------------------------------------------
	11	!! sbc_ssr : add to sbc a restoring term toward SST/SSS climatology
	12	!!----------------------------------------------------------------------
	13	USE oce ! ocean dynamics and tracers
	14	USE dom_oce ! ocean space and time domain
	15	USE sbc_oce ! surface boundary condition
	16	USE phycst ! physical constants
	17	USE sbcrnf ! surface boundary condition : runoffs
	18	USE fldread ! read input fields
	19	USE iom ! I/O manager
	20	USE in_out_manager ! I/O manager
	21	USE lib_mpp ! distribued memory computing library
	22	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
[3294]	23	USE timing ! Timing
[888]	24
	25	IMPLICIT NONE
	26	PRIVATE
	27
	28	PUBLIC sbc_ssr ! routine called in sbcmod
	29
[2715]	30	REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: erp !: evaporation damping [kg/m2/s]
	31	REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qrp !: heat flux damping [w/m2]
[1524]	32
[1601]	33	! !!* Namelist namsbc_ssr *
	34	INTEGER, PUBLIC :: nn_sstr = 0 ! SST/SSS restoring indicator
	35	INTEGER, PUBLIC :: nn_sssr = 0 ! SST/SSS restoring indicator
	36	REAL(wp) :: rn_dqdt = -40.e0 ! restoring factor on SST and SSS
	37	REAL(wp) :: rn_deds = -27.70 ! restoring factor on SST and SSS
	38	LOGICAL :: ln_sssr_bnd = .false. ! flag to bound erp term
	39	REAL(wp) :: rn_sssr_bnd = 0.e0 ! ABS(Max./Min.) value of erp term [mm/day]
[1524]	40
	41	REAL(wp) , ALLOCATABLE, DIMENSION(:) :: buffer ! Temporary buffer for exchange
[1106]	42	TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_sst ! structure of input SST (file informations, fields read)
	43	TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_sss ! structure of input SSS (file informations, fields read)
[888]	44
	45	!! * Substitutions
	46	# include "domzgr_substitute.h90"
	47	!!----------------------------------------------------------------------
[2715]	48	!! NEMO/OPA 4.0 , NEMO Consortium (2011)
[1156]	49	!! $Id$
[2715]	50	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[888]	51	!!----------------------------------------------------------------------
	52	CONTAINS
	53
	54	SUBROUTINE sbc_ssr( kt )
	55	!!---------------------------------------------------------------------
	56	!! * ROUTINE sbc_ssr *
	57	!!
	58	!! ** Purpose : Add to heat and/or freshwater fluxes a damping term
	59	!! toward observed SST and/or SSS.
	60	!!
	61	!! ** Method : - Read namelist namsbc_ssr
	62	!! - Read observed SST and/or SSS
	63	!! - at each nscb time step
	64	!! add a retroaction term on qns (nn_sstr = 1)
	65	!! add a damping term on emps (nn_sssr = 1)
	66	!! add a damping term on emp & emps (nn_sssr = 2)
	67	!!---------------------------------------------------------------------
	68	INTEGER, INTENT(in ) :: kt ! ocean time step
	69	!!
	70	INTEGER :: ji, jj ! dummy loop indices
	71	REAL(wp) :: zerp ! local scalar for evaporation damping
	72	REAL(wp) :: zqrp ! local scalar for heat flux damping
[1601]	73	REAL(wp) :: zsrp ! local scalar for unit conversion of rn_deds factor
[1554]	74	REAL(wp) :: zerp_bnd ! local scalar for unit conversion of rn_epr_max factor
[888]	75	INTEGER :: ierror ! return error code
	76	!!
	77	CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files
	78	TYPE(FLD_N) :: sn_sst, sn_sss ! informations about the fields to be read
[1601]	79	NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, sn_sss, ln_sssr_bnd, rn_sssr_bnd
[888]	80	!!----------------------------------------------------------------------
[1524]	81	!
[3294]	82	IF( nn_timing == 1 ) CALL timing_start('sbc_ssr')
	83	!
[888]	84	! ! -------------------- !
	85	IF( kt == nit000 ) THEN ! First call kt=nit000 !
	86	! ! -------------------- !
[1601]	87	! !* set file information
[1524]	88	cn_dir = './' ! directory in which the model is executed
[888]	89	! ... default values (NB: frequency positive => hours, negative => months)
[1275]	90	! ! file ! frequency ! variable ! time intep ! clim ! 'yearly' or ! weights ! rotation !
	91	! ! name ! (hours) ! name ! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs !
[1730]	92	sn_sst = FLD_N( 'sst' , 24 , 'sst' , .false. , .false. , 'yearly' , '' , '' )
	93	sn_sss = FLD_N( 'sss' , -1 , 'sss' , .true. , .false. , 'yearly' , '' , '' )
[888]	94
[1524]	95	REWIND ( numnam ) !* read in namlist namflx
[888]	96	READ( numnam, namsbc_ssr )
	97
[1524]	98	IF(lwp) THEN !* control print
[888]	99	WRITE(numout,*)
	100	WRITE(numout,*) 'sbc_ssr : SST and/or SSS damping term '
	101	WRITE(numout,*) '~~~~~~~ '
[1601]	102	WRITE(numout,*) ' Namelist namsbc_ssr :'
	103	WRITE(numout,*) ' SST restoring term (Yes=1) nn_sstr = ', nn_sstr
	104	WRITE(numout,*) ' SSS damping term (Yes=1, salt flux) nn_sssr = ', nn_sssr
	105	WRITE(numout,*) ' (Yes=2, volume flux) '
	106	WRITE(numout,*) ' dQ/dT (restoring magnitude on SST) rn_dqdt = ', rn_dqdt, ' W/m2/K'
	107	WRITE(numout,*) ' dE/dS (restoring magnitude on SST) rn_deds = ', rn_deds, ' mm/day'
	108	WRITE(numout,*) ' flag to bound erp term ln_sssr_bnd = ', ln_sssr_bnd
	109	WRITE(numout,*) ' ABS(Max./Min.) erp threshold rn_sssr_bnd = ', rn_sssr_bnd, ' mm/day'
[888]	110	ENDIF
	111
[2715]	112	! Allocate erp and qrp array
	113	ALLOCATE( qrp(jpi,jpj), erp(jpi,jpj), STAT=ierror )
	114	IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate erp and qrp array' )
	115
	116	IF( nn_sstr == 1 ) THEN !* set sf_sst structure & allocate arrays
[888]	117	!
	118	ALLOCATE( sf_sst(1), STAT=ierror )
[2715]	119	IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sst structure' )
	120	ALLOCATE( sf_sst(1)%fnow(jpi,jpj,1), STAT=ierror )
	121	IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sst now array' )
[1524]	122	!
[1133]	123	! fill sf_sst with sn_sst and control print
	124	CALL fld_fill( sf_sst, (/ sn_sst /), cn_dir, 'sbc_ssr', 'SST restoring term toward SST data', 'namsbc_ssr' )
[2715]	125	IF( sf_sst(1)%ln_tint ) ALLOCATE( sf_sst(1)%fdta(jpi,jpj,1,2), STAT=ierror )
	126	IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sst data array' )
	127	!
[888]	128	ENDIF
	129	!
[2715]	130	IF( nn_sssr >= 1 ) THEN ! set sf_sss structure & allocate arrays
[888]	131	!
	132	ALLOCATE( sf_sss(1), STAT=ierror )
[2715]	133	IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss structure' )
	134	ALLOCATE( sf_sss(1)%fnow(jpi,jpj,1), STAT=ierror )
	135	IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss now array' )
[1524]	136	!
[1133]	137	! fill sf_sss with sn_sss and control print
	138	CALL fld_fill( sf_sss, (/ sn_sss /), cn_dir, 'sbc_ssr', 'SSS restoring term toward SSS data', 'namsbc_ssr' )
[2715]	139	IF( sf_sss(1)%ln_tint ) ALLOCATE( sf_sss(1)%fdta(jpi,jpj,1,2), STAT=ierror )
	140	IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss data array' )
	141	!
[888]	142	ENDIF
	143	!
	144	! Initialize qrp and erp if no restoring
	145	IF( nn_sstr /= 1 ) qrp(:,:) = 0.e0
	146	IF( nn_sssr /= 1 .OR. nn_sssr /= 2 ) erp(:,:) = 0.e0
	147	ENDIF
	148
	149	IF( nn_sstr + nn_sssr /= 0 ) THEN
[1524]	150	!
	151	IF( nn_sstr == 1) CALL fld_read( kt, nn_fsbc, sf_sst ) ! Read SST data and provides it at kt
	152	IF( nn_sssr >= 1) CALL fld_read( kt, nn_fsbc, sf_sss ) ! Read SSS data and provides it at kt
	153	!
[888]	154	! ! ========================= !
	155	IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! Add restoring term !
	156	! ! ========================= !
	157	!
[1524]	158	IF( nn_sstr == 1 ) THEN !* Temperature restoring term
[888]	159	!CDIR COLLAPSE
	160	DO jj = 1, jpj
	161	DO ji = 1, jpi
[2528]	162	zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) )
[888]	163	qns(ji,jj) = qns(ji,jj) + zqrp
	164	qrp(ji,jj) = zqrp
	165	END DO
	166	END DO
[1482]	167	CALL iom_put( "qrp", qrp ) ! heat flux damping
[888]	168	ENDIF
	169	!
[1524]	170	IF( nn_sssr == 1 ) THEN !* Salinity damping term (salt flux, emps only)
[1601]	171	zsrp = rn_deds / rday ! from [mm/day] to [kg/m2/s]
[888]	172	!CDIR COLLAPSE
	173	DO jj = 1, jpj
	174	DO ji = 1, jpi
	175	zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) ) & ! No damping in vicinity of river mouths
[2528]	176	& * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) ) &
[888]	177	& / ( sss_m(ji,jj) + 1.e-20 )
	178	emps(ji,jj) = emps(ji,jj) + zerp
	179	erp( ji,jj) = zerp
	180	END DO
	181	END DO
[1482]	182	CALL iom_put( "erp", erp ) ! freshwater flux damping
[1601]	183	!
[1524]	184	ELSEIF( nn_sssr == 2 ) THEN !* Salinity damping term (volume flux, emp and emps)
[1601]	185	zsrp = rn_deds / rday ! from [mm/day] to [kg/m2/s]
[1554]	186	zerp_bnd = rn_sssr_bnd / rday ! - -
[888]	187	!CDIR COLLAPSE
	188	DO jj = 1, jpj
	189	DO ji = 1, jpi
	190	zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) ) & ! No damping in vicinity of river mouths
[2528]	191	& * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) ) &
[888]	192	& / ( sss_m(ji,jj) + 1.e-20 )
[1554]	193	IF( ln_sssr_bnd ) zerp = SIGN( 1., zerp ) * MIN( zerp_bnd, ABS(zerp) )
[888]	194	emp (ji,jj) = emp (ji,jj) + zerp
	195	emps(ji,jj) = emps(ji,jj) + zerp
	196	erp (ji,jj) = zerp
	197	END DO
	198	END DO
[1482]	199	CALL iom_put( "erp", erp ) ! freshwater flux damping
[888]	200	ENDIF
	201	!
	202	ENDIF
	203	!
	204	ENDIF
	205	!
[3294]	206	IF( nn_timing == 1 ) CALL timing_stop('sbc_ssr')
	207	!
[888]	208	END SUBROUTINE sbc_ssr
	209
	210	!!======================================================================
	211	END MODULE sbcssr

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

Download in other formats: