Context Navigation

dtatem.F90 @ 2513

Last change on this file since 2513 was 2450, checked in by gm, 14 years ago
v3.3beta: #766 share the deepest ocean level indices continuaton
Property svn:keywords set to `Id`
File size: 10.4 KB

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

Download in other formats: