Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

dtatem.F90 @ 2144

Last change on this file since 2144 was 2104, checked in by cetlod, 14 years ago
update DEV_r2006_merge_TRA_TRC according to review
Property svn:eol-style set to `native` Property svn:keywords set to `Id`
File size: 11.7 KB

Rev	Line
[3]	1	MODULE dtatem
	2	!!======================================================================
	3	!! * MODULE dtatem *
	4	!! Ocean data : read ocean temperature data from monthly atlas data
	5	!!=====================================================================
	6	#if defined key_dtatem \|\| defined key_esopa
	7	!!----------------------------------------------------------------------
	8	!! 'key_dtatem' 3D temperature data field
	9	!!----------------------------------------------------------------------
	10	!! dta_tem : read ocean temperature data
[473]	11	!!---l-------------------------------------------------------------------
[3]	12	!! * Modules used
	13	USE oce ! ocean dynamics and tracers
	14	USE dom_oce ! ocean space and time domain
[1951]	15	USE fldread ! read input fields
[3]	16	USE in_out_manager ! I/O manager
[473]	17	USE phycst ! physical constants
	18	#if defined key_orca_lev10
	19	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
	20	#endif
[3]	21	IMPLICIT NONE
	22	PRIVATE
	23
	24	!! * Routine accessibility
	25	PUBLIC dta_tem ! called by step.F90 and inidta.F90
	26
	27	!! * Shared module variables
[16]	28	LOGICAL , PUBLIC, PARAMETER :: lk_dtatem = .TRUE. !: temperature data flag
[1951]	29	REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: t_dta !: temperature data at given time-step
[3]	30
	31	!! * Module variables
[1951]	32	TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_tem ! structure of input SST (file informations, fields read)
[3]	33
	34	!! * Substitutions
	35	# include "domzgr_substitute.h90"
	36	!!----------------------------------------------------------------------
[247]	37	!! OPA 9.0 , LOCEAN-IPSL (2005)
[1152]	38	!! $Id$
[247]	39	!! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
[3]	40	!!----------------------------------------------------------------------
	41
	42	CONTAINS
	43
	44	!!----------------------------------------------------------------------
	45	!! Default case NetCDF file
	46	!!----------------------------------------------------------------------
	47
	48	SUBROUTINE dta_tem( kt )
	49	!!----------------------------------------------------------------------
	50	!! * ROUTINE dta_tem *
	51	!!
	52	!! ** Purpose : Reads monthly temperature data
	53	!!
	54	!! ** Method : Read on unit numtdt the interpolated temperature
	55	!! onto the model grid.
	56	!! Data begin at january.
	57	!! The value is centered at the middle of month.
	58	!! In the opa model, kt=1 agree with january 1.
	59	!! At each time step, a linear interpolation is applied between
	60	!! two monthly values.
	61	!! Read on unit numtdt
	62	!!
	63	!! ** Action : define t_dta array at time-step kt
	64	!!
	65	!! History :
	66	!! ! 91-03 () Original code
	67	!! ! 92-07 (M. Imbard)
	68	!! ! 99-10 (M.A. Foujols, M. Imbard) NetCDF FORMAT
	69	!! 8.5 ! 02-09 (G. Madec) F90: Free form and module
	70	!!----------------------------------------------------------------------
	71	!! * Arguments
	72	INTEGER, INTENT( in ) :: kt ! ocean time-step
	73
	74	!! * Local declarations
[1951]	75	INTEGER :: ji, jj, jk, jl, jkk ! dummy loop indicies
[2104]	76	INTEGER :: ik, ierror ! temporary integers
[1951]	77	#if defined key_tradmp
	78	INTEGER :: il0, il1, ii0, ii1, ij0, ij1 ! temporary integers
	79	#endif
[2104]	80	REAL(wp):: zl
[473]	81	#if defined key_orca_lev10
[1951]	82	INTEGER :: ikr, ikw, ikt, jjk
	83	REAL(wp):: zfac
[473]	84	#endif
[1951]	85	REAL(wp), DIMENSION(jpk) :: ztemdta ! auxiliary array for interpolation
	86	CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files
	87	TYPE(FLD_N) :: sn_tem
	88	LOGICAL , SAVE :: linit_tem = .FALSE.
[3]	89	!!----------------------------------------------------------------------
[1951]	90	NAMELIST/namdta_tem/cn_dir,sn_tem
	91
	92	! 1. Initialization
[473]	93	! -----------------------
	94
[1951]	95	IF( kt == nit000 .AND. (.NOT. linit_tem ) ) THEN
	96
	97	! ! set file information
	98	cn_dir = './' ! directory in which the model is executed
	99	! ... default values (NB: frequency positive => hours, negative => months)
	100	! ! file ! frequency ! variable ! time intep ! clim ! 'yearly' or ! weights ! rotation !
	101	! ! name ! (hours) ! name ! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs !
	102	sn_tem = FLD_N( 'temperature', -1. , 'votemper', .false. , .true. , 'yearly' , '' , '' )
	103
	104	REWIND( numnam ) ! ... read in namlist namdta_tem
	105	READ( numnam, namdta_tem )
	106
	107	IF(lwp) THEN ! control print
	108	WRITE(numout,*)
	109	WRITE(numout,*) 'dta_tem : Temperature Climatology '
	110	WRITE(numout,*) '~~~~~~~ '
	111	ENDIF
	112	ALLOCATE( sf_tem(1), STAT=ierror )
	113	IF( ierror > 0 ) THEN
	114	CALL ctl_stop( 'dta_tem: unable to allocate sf_tem structure' ) ; RETURN
	115	ENDIF
	116
	117	#if defined key_orca_lev10
	118	ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpkdta ) )
	119	ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpkdta,2) )
	120	#else
	121	ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpk ) )
	122	ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpk,2) )
	123	#endif
	124	! fill sf_tem with sn_tem and control print
	125	CALL fld_fill( sf_tem, (/ sn_tem /), cn_dir, 'dta_tem', 'Temperature data', 'namdta_tem' )
	126	linit_tem = .TRUE.
	127
[473]	128	ENDIF
	129
	130	! 2. Read monthly file
	131	! -------------------
	132
[1951]	133	CALL fld_read( kt, 1, sf_tem )
	134
	135	IF( lwp .AND. kt==nn_it000 )THEN
	136	WRITE(numout,*)
	137	WRITE(numout,*) ' read Levitus temperature ok'
	138	WRITE(numout,*)
	139	ENDIF
[473]	140
[434]	141	#if defined key_tradmp
[1951]	142	IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN
[473]	143
[1951]	144	! ! =======================
	145	! ! ORCA_R2 configuration
	146	! ! =======================
	147	ij0 = 101 ; ij1 = 109
	148	ii0 = 141 ; ii1 = 155
	149	DO jj = mj0(ij0), mj1(ij1) ! Reduced temperature in the Alboran Sea
	150	DO ji = mi0(ii0), mi1(ii1)
	151	sf_tem(1)%fnow(ji,jj, 13:13 ) = sf_tem(1)%fnow(ji,jj, 13:13 ) - 0.20
	152	sf_tem(1)%fnow(ji,jj, 14:15 ) = sf_tem(1)%fnow(ji,jj, 14:15 ) - 0.35
	153	sf_tem(1)%fnow(ji,jj, 16:25 ) = sf_tem(1)%fnow(ji,jj, 16:25 ) - 0.40
[473]	154	END DO
[1951]	155	END DO
[473]	156
[1951]	157	IF( n_cla == 1 ) THEN
	158	! ! New temperature profile at Gibraltar
	159	il0 = 138 ; il1 = 138
	160	ij0 = 101 ; ij1 = 102
	161	ii0 = 139 ; ii1 = 139
	162	DO jl = mi0(il0), mi1(il1)
	163	DO jj = mj0(ij0), mj1(ij1)
	164	DO ji = mi0(ii0), mi1(ii1)
	165	sf_tem(1)%fnow(ji,jj,:) = sf_tem(1)%fnow(jl,jj,:)
[473]	166	END DO
	167	END DO
[1951]	168	END DO
	169	! ! New temperature profile at Bab el Mandeb
	170	il0 = 164 ; il1 = 164
	171	ij0 = 87 ; ij1 = 88
	172	ii0 = 161 ; ii1 = 163
	173	DO jl = mi0(il0), mi1(il1)
	174	DO jj = mj0(ij0), mj1(ij1)
	175	DO ji = mi0(ii0), mi1(ii1)
	176	sf_tem(1)%fnow(ji,jj,:) = sf_tem(1)%fnow(jl,jj,:)
[473]	177	END DO
[1273]	178	END DO
[1951]	179	END DO
[1273]	180	!
[1951]	181	ELSE
	182	! ! Reduced temperature at Red Sea
	183	ij0 = 87 ; ij1 = 96
	184	ii0 = 148 ; ii1 = 160
	185	sf_tem(1)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 4:10 ) = 7.0
	186	sf_tem(1)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5
	187	sf_tem(1)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0
[473]	188	ENDIF
[1951]	189	!
	190	ENDIF
[473]	191	#endif
	192
	193	#if defined key_orca_lev10
[1951]	194	DO jjk = 1, 5
	195	t_dta(:,:,jjk) = sf_tem(1)%fnow(:,:,1)
	196	END DO
	197	DO jk = 1, jpk-20,10
	198	ik = jk+5
	199	ikr = INT(jk/10) + 1
	200	ikw = (ikr-1) *10 + 1
	201	ikt = ikw + 5
	202	DO jjk=ikt,ikt+9
	203	zfac = ( gdept_0(jjk ) - gdepw_0(ikt) ) / ( gdepw_0(ikt+10) - gdepw_0(ikt) )
	204	t_dta(:,:,jjk) = sf_tem(1)%fnow(:,:,ikr) + ( sf_tem(1)%fnow(:,:,ikr+1) - sf_tem(1)%fnow(:,:,ikr) ) * zfac
[473]	205	END DO
[1951]	206	END DO
	207	DO jjk = jpk-5, jpk
	208	t_dta(:,:,jjk) = sf_tem(1)%fnow(:,:,jpkdta-1)
	209	END DO
	210	! fill the overlap areas
	211	CALL lbc_lnk (t_dta(:,:,:),'Z',-999.,'no0')
	212	#else
	213	t_dta(:,:,:) = sf_tem(1)%fnow(:,:,:)
[473]	214	#endif
	215
[1951]	216	IF( ln_sco ) THEN
	217	DO jj = 1, jpj ! interpolation of temperatures
	218	DO ji = 1, jpi
	219	DO jk = 1, jpk
	220	zl=fsdept_0(ji,jj,jk)
	221	IF(zl < gdept_0(1)) ztemdta(jk) = t_dta(ji,jj,1)
	222	IF(zl > gdept_0(jpk)) ztemdta(jk) = t_dta(ji,jj,jpkm1)
	223	DO jkk = 1, jpkm1
	224	IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN
	225	ztemdta(jk) = t_dta(ji,jj,jkk) &
	226	& + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk)) &
	227	& * (t_dta(ji,jj,jkk+1) - t_dta(ji,jj,jkk))
	228	ENDIF
[473]	229	END DO
	230	END DO
[1951]	231	DO jk = 1, jpkm1
	232	t_dta(ji,jj,jk) = ztemdta(jk)
	233	END DO
	234	t_dta(ji,jj,jpk) = 0.0
[473]	235	END DO
[1951]	236	END DO
[473]	237
[1951]	238	IF( lwp .AND. kt==nn_it000 )THEN
	239	WRITE(numout,*)
	240	WRITE(numout,*) ' Levitus temperature data interpolated to s-coordinate'
	241	WRITE(numout,*)
	242	ENDIF
[473]	243
[1951]	244	ELSE
	245	! ! Mask
	246	t_dta(:,:,: ) = t_dta(:,:,:) * tmask(:,:,:)
	247	t_dta(:,:,jpk) = 0.
	248	IF( ln_zps ) THEN ! z-coord. with partial steps
	249	DO jj = 1, jpj ! interpolation of temperature at the last level
	250	DO ji = 1, jpi
	251	ik = mbathy(ji,jj) - 1
	252	IF( ik > 2 ) THEN
	253	zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) )
	254	t_dta(ji,jj,ik) = (1.-zl) * t_dta(ji,jj,ik) + zl * t_dta(ji,jj,ik-1)
	255	ENDIF
[473]	256	END DO
[1951]	257	END DO
[473]	258	ENDIF
[3]	259
[1951]	260	ENDIF
	261
	262	IF( lwp .AND. kt==nn_it000 ) THEN
	263	WRITE(numout,*) ' temperature Levitus '
	264	WRITE(numout,*)
	265	WRITE(numout,*)' level = 1'
	266	CALL prihre( t_dta(:,:,1 ), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
	267	WRITE(numout,*)' level = ', jpk/2
	268	CALL prihre( t_dta(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
	269	WRITE(numout,*)' level = ', jpkm1
	270	CALL prihre( t_dta(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
	271	ENDIF
	272
	273	END SUBROUTINE dta_tem
	274
[3]	275	#else
	276	!!----------------------------------------------------------------------
	277	!! Default case NO 3D temperature data field
	278	!!----------------------------------------------------------------------
[16]	279	LOGICAL , PUBLIC, PARAMETER :: lk_dtatem = .FALSE. !: temperature data flag
[3]	280	CONTAINS
	281	SUBROUTINE dta_tem( kt ) ! Empty routine
[16]	282	WRITE(,) 'dta_tem: You should not have seen this print! error?', kt
[3]	283	END SUBROUTINE dta_tem
	284	#endif
	285	!!======================================================================
	286	END MODULE dtatem

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

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

Context Navigation

source: branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/DTA/dtatem.F90 @ 2144

Download in other formats: