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.

sbcflx.F90 in branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

Context Navigation

source: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90 @ 4416

Last change on this file since 4416 was 3211, checked in by spickles2, 12 years ago

Stephen Pickles, 11 Dec 2011

Commit to bring the rest of the DCSE NEMO development branch
in line with the latest development version. This includes
array index re-ordering of all OPA_SRC/.

Property svn:keywords set to Id

File size: 9.7 KB

Rev	Line
[888]	1	MODULE sbcflx
	2	!!======================================================================
	3	!! * MODULE sbcflx *
	4	!! Ocean forcing: momentum, heat and freshwater flux formulation
	5	!!=====================================================================
[2528]	6	!! History : 1.0 ! 2006-06 (G. Madec) Original code
	7	!! 3.3 ! 2010-10 (S. Masson) add diurnal cycle
[888]	8	!!----------------------------------------------------------------------
	9
	10	!!----------------------------------------------------------------------
	11	!! namflx : flux formulation namlist
[2528]	12	!! sbc_flx : flux formulation as ocean surface boundary condition (forced mode, fluxes read in NetCDF files)
[888]	13	!!----------------------------------------------------------------------
	14	USE oce ! ocean dynamics and tracers
	15	USE dom_oce ! ocean space and time domain
[2528]	16	USE sbc_oce ! surface boundary condition: ocean fields
	17	USE sbcdcy ! surface boundary condition: diurnal cycle on qsr
[888]	18	USE phycst ! physical constants
	19	USE fldread ! read input fields
	20	USE iom ! IOM library
	21	USE in_out_manager ! I/O manager
	22	USE lib_mpp ! distribued memory computing library
	23	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
	24
	25	IMPLICIT NONE
	26	PRIVATE
	27
	28	PUBLIC sbc_flx ! routine called by step.F90
	29
	30	INTEGER , PARAMETER :: jpfld = 5 ! maximum number of files to read
	31	INTEGER , PARAMETER :: jp_utau = 1 ! index of wind stress (i-component) file
	32	INTEGER , PARAMETER :: jp_vtau = 2 ! index of wind stress (j-component) file
	33	INTEGER , PARAMETER :: jp_qtot = 3 ! index of total (non solar+solar) heat file
	34	INTEGER , PARAMETER :: jp_qsr = 4 ! index of solar heat file
	35	INTEGER , PARAMETER :: jp_emp = 5 ! index of evaporation-precipation file
	36	TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf ! structure of input fields (file informations, fields read)
	37
[3211]	38	!! * Control permutation of array indices
	39	# include "oce_ftrans.h90"
	40	# include "dom_oce_ftrans.h90"
	41	# include "sbc_oce_ftrans.h90"
	42
[888]	43	!! * Substitutions
	44	# include "domzgr_substitute.h90"
[1029]	45	# include "vectopt_loop_substitute.h90"
[888]	46	!!----------------------------------------------------------------------
[2528]	47	!! NEMO/OPA 3.3 , NEMO-consortium (2010)
[1156]	48	!! $Id$
[2715]	49	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[888]	50	!!----------------------------------------------------------------------
	51	CONTAINS
	52
	53	SUBROUTINE sbc_flx( kt )
	54	!!---------------------------------------------------------------------
	55	!! * ROUTINE sbc_flx *
	56	!!
	57	!! ** Purpose : provide at each time step the surface ocean fluxes
	58	!! (momentum, heat, freshwater and runoff)
	59	!!
	60	!! ** Method : - READ each fluxes in NetCDF files:
	61	!! i-component of the stress utau (N/m2)
	62	!! j-component of the stress vtau (N/m2)
	63	!! net downward heat flux qtot (watt/m2)
	64	!! net downward radiative flux qsr (watt/m2)
	65	!! net upward freshwater (evapo - precip) emp (kg/m2/s)
	66	!!
	67	!! CAUTION : - never mask the surface stress fields
	68	!! - the stress is assumed to be in the mesh referential
	69	!! i.e. the (i,j) referential
	70	!!
	71	!! ** Action : update at each time-step
[1695]	72	!! - utau, vtau i- and j-component of the wind stress
	73	!! - taum wind stress module at T-point
	74	!! - wndm 10m wind module at T-point
	75	!! - qns, qsr non-slor and solar heat flux
	76	!! - emp, emps evaporation minus precipitation
[888]	77	!!----------------------------------------------------------------------
	78	INTEGER, INTENT(in) :: kt ! ocean time step
	79	!!
[1695]	80	INTEGER :: ji, jj, jf ! dummy indices
	81	INTEGER :: ierror ! return error code
	82	REAL(wp) :: zfact ! temporary scalar
	83	REAL(wp) :: zrhoa = 1.22 ! Air density kg/m3
	84	REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient
	85	REAL(wp) :: ztx, zty, zmod, zcoef ! temporary variables
[888]	86	!!
	87	CHARACTER(len=100) :: cn_dir ! Root directory for location of flx files
	88	TYPE(FLD_N), DIMENSION(jpfld) :: slf_i ! array of namelist information structures
	89	TYPE(FLD_N) :: sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp ! informations about the fields to be read
	90	NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp
	91	!!---------------------------------------------------------------------
[2528]	92	!
	93	IF( kt == nit000 ) THEN ! First call kt=nit000
[888]	94	! set file information
	95	cn_dir = './' ! directory in which the model is executed
	96	! ... default values (NB: frequency positive => hours, negative => months)
[2528]	97	! ! file ! frequency ! variable ! time intep ! clim ! 'yearly' or ! weights ! rotation !
	98	! ! name ! (hours) ! name ! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs !
	99	sn_utau = FLD_N( 'utau' , 24 , 'utau' , .false. , .false. , 'yearly' , '' , '' )
	100	sn_vtau = FLD_N( 'vtau' , 24 , 'vtau' , .false. , .false. , 'yearly' , '' , '' )
	101	sn_qtot = FLD_N( 'qtot' , 24 , 'qtot' , .false. , .false. , 'yearly' , '' , '' )
	102	sn_qsr = FLD_N( 'qsr' , 24 , 'qsr' , .false. , .false. , 'yearly' , '' , '' )
	103	sn_emp = FLD_N( 'emp' , 24 , 'emp' , .false. , .false. , 'yearly' , '' , '' )
	104	!
	105	REWIND ( numnam ) ! read in namlist namflx
[888]	106	READ ( numnam, namsbc_flx )
[2528]	107	!
	108	! ! check: do we plan to use ln_dm2dc with non-daily forcing?
	109	IF( ln_dm2dc .AND. sn_qsr%nfreqh /= 24 ) &
	110	& CALL ctl_stop( 'sbc_blk_core: ln_dm2dc can be activated only with daily short-wave forcing' )
	111	!
	112	! ! store namelist information in an array
[888]	113	slf_i(jp_utau) = sn_utau ; slf_i(jp_vtau) = sn_vtau
	114	slf_i(jp_qtot) = sn_qtot ; slf_i(jp_qsr ) = sn_qsr
	115	slf_i(jp_emp ) = sn_emp
[2528]	116	!
	117	ALLOCATE( sf(jpfld), STAT=ierror ) ! set sf structure
[1133]	118	IF( ierror > 0 ) THEN
	119	CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' ) ; RETURN
[888]	120	ENDIF
[1200]	121	DO ji= 1, jpfld
[2528]	122	ALLOCATE( sf(ji)%fnow(jpi,jpj,1) )
	123	IF( slf_i(ji)%ln_tint ) ALLOCATE( sf(ji)%fdta(jpi,jpj,1,2) )
[1200]	124	END DO
[2528]	125	! ! fill sf with slf_i and control print
[1133]	126	CALL fld_fill( sf, slf_i, cn_dir, 'sbc_flx', 'flux formulation for ocean surface boundary condition', 'namsbc_flx' )
[888]	127	!
	128	ENDIF
	129
[2528]	130	CALL fld_read( kt, nn_fsbc, sf ) ! input fields provided at the current time-step
	131
	132	IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! update ocean fluxes at each SBC frequency
[888]	133
[2528]	134	IF( ln_dm2dc ) THEN ; qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) ! modify now Qsr to include the diurnal cycle
	135	ELSE ; qsr(:,:) = sf(jp_qsr)%fnow(:,:,1)
	136	ENDIF
[888]	137	!CDIR COLLAPSE
[2528]	138	DO jj = 1, jpj ! set the ocean fluxes from read fields
[1274]	139	DO ji = 1, jpi
[2528]	140	utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1)
	141	vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1)
	142	qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1)
	143	emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1)
[1274]	144	END DO
[888]	145	END DO
[2528]	146	! ! module of wind stress and wind speed at T-point
	147	zcoef = 1. / ( zrhoa * zcdrag )
[1695]	148	!CDIR NOVERRCHK
	149	DO jj = 2, jpjm1
	150	!CDIR NOVERRCHK
	151	DO ji = fs_2, fs_jpim1 ! vect. opt.
	152	ztx = utau(ji-1,jj ) + utau(ji,jj)
	153	zty = vtau(ji ,jj-1) + vtau(ji,jj)
	154	zmod = 0.5 * SQRT( ztx * ztx + zty * zty )
	155	taum(ji,jj) = zmod
	156	wndm(ji,jj) = SQRT( zmod * zcoef )
	157	END DO
	158	END DO
	159	CALL lbc_lnk( taum(:,:), 'T', 1. ) ; CALL lbc_lnk( wndm(:,:), 'T', 1. )
	160
[2528]	161	emps(:,:) = emp (:,:) ! Initialization of emps (needed when no ice model)
[1695]	162
[2528]	163	IF( nitend-nit000 <= 100 .AND. lwp ) THEN ! control print (if less than 100 time-step asked)
[888]	164	WRITE(numout,*)
[1274]	165	WRITE(numout,*) ' read daily momentum, heat and freshwater fluxes OK'
	166	DO jf = 1, jpfld
	167	IF( jf == jp_utau .OR. jf == jp_vtau ) zfact = 1.
	168	IF( jf == jp_qtot .OR. jf == jp_qsr ) zfact = 0.1
	169	IF( jf == jp_emp ) zfact = 86400.
	170	WRITE(numout,*)
	171	WRITE(numout,) ' day: ', ndastp , TRIM(sf(jf)%clvar), ' ', zfact
	172	CALL prihre( sf(jf)%fnow, jpi, jpj, 1, jpi, 20, 1, jpj, 10, zfact, numout )
	173	END DO
	174	CALL FLUSH(numout)
	175	ENDIF
	176	!
[888]	177	ENDIF
	178	!
	179	END SUBROUTINE sbc_flx
	180
	181	!!======================================================================
	182	END MODULE sbcflx

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

Download in other formats: