Context Navigation

startvar.F @ 4667

Last change on this file since 4667 was 1299, checked in by Laurent Fairhead, 15 years ago

Nettoyage general pour se rapprocher des normes et éviter des erreurs a la
compilation:

tous les FLOAT() sont remplacés par des REAL()
tous les STOP dans phylmd sont remplacés par des appels à abort_gcm
le common control défini dans le fichier control.h est remplacé par le module control_mod pour éviter des messages sur l'alignement des variables dans les déclarations
des $Header$ remplacés par des $Id$ pour svn

Quelques remplacements à faire ont pu m'échapper

General cleanup of the code to try and adhere to norms and to prevent some
compilation errors:

all FLOAT() instructions have been replaced by REAL() instructions
all STOP instructions in phylmd have been replaced by calls to abort_gcm
the common block control defined in the control.h file has been replaced by the control_mod to prevent compilation warnings on the alignement of declared variables
$Header$ replaced by $Id$ for svn

Some changes which should have been made might have escaped me

Property svn:eol-style set to native
Property svn:keywords set to Author Date Id Revision

File size: 40.3 KB

Rev	Line
[630]	1	!
[1279]	2	! $Id: startvar.F 1299 2010-01-20 14:27:21Z fhourdin $
[630]	3	!
	4	MODULE startvar
[1279]	5	#ifdef CPP_EARTH
	6	! This module is designed to work for Earth (and with ioipsl)
[630]	7	!
	8	!
	9	! There are three ways to access data from the database of atmospheric data which
	10	! can be used to initialize the model. This depends on the type of field which needs
[1293]	11	! to be extracted.
[630]	12	! We will details the possible arguments to startget here :
	13	!
	14	! - A 2D variable on the dynamical grid :
[1293]	15	! CALL startget_phys2d(varname, iml, jml, lon_in, lat_in, champ, val_ex, jml2, lon_in2, lat_in2, interbar )
[630]	16	!
	17	! - A 1D variable on the physical grid :
[1293]	18	! CALL startget_phys1d(varname, iml, jml, lon_in, lat_in, nbindex, champ, val_exp, jml2, lon_in2, lat_in2, interbar )
[630]	19	!
	20	!
	21	! - A 3D variable on the dynamical grid :
[1293]	22	! CALL startget_dyn(varname, iml, jml, lon_in, lat_in, lml, pls, workvar, champ, val_exp, jml2, lon_in2, lat_in2, interbar )
[630]	23	!
	24	!
	25	! There is special constraint on the atmospheric data base except that the
	26	! the data needs to be in netCDF and the variables should have the the following
	27	! names in the file :
	28	!
	29	! 'RELIEF' : High resolution orography
	30	! 'ST' : Surface temperature
	31	! 'CDSW' : Soil moisture
	32	! 'Z' : Surface geopotential
	33	! 'SP' : Surface pressure
	34	! 'U' : East ward wind
	35	! 'V' : Northward wind
	36	! 'TEMP' : Temperature
	37	! 'R' : Relative humidity
	38	!
	39	USE ioipsl
	40	!
	41	!
	42	IMPLICIT NONE
	43	!
	44	!
	45	PRIVATE
[1293]	46	public startget_phys2d, startget_phys1d, startget_dyn
[630]	47	!
	48	INTEGER, SAVE :: fid_phys, fid_dyn
	49	INTEGER, SAVE :: iml_phys, iml_rel, iml_dyn
	50	INTEGER, SAVE :: jml_phys, jml_rel, jml_dyn
	51	INTEGER, SAVE :: llm_dyn, ttm_dyn
	52	REAL, ALLOCATABLE, SAVE, DIMENSION (:,:) :: lon_phys, lon_rug,
	53	. lon_alb, lon_rel, lon_dyn
	54	REAL, ALLOCATABLE, SAVE, DIMENSION (:,:) :: lat_phys, lat_rug,
	55	. lat_alb, lat_rel, lat_dyn
	56	REAL, ALLOCATABLE, SAVE, DIMENSION (:) :: levdyn_ini
	57	REAL, ALLOCATABLE, SAVE, DIMENSION (:,:) :: relief, zstd, zsig,
	58	. zgam, zthe, zpic, zval
	59	REAL, ALLOCATABLE, SAVE, DIMENSION (:,:) :: rugo, masque, phis
	60	!
	61	REAL, ALLOCATABLE, SAVE, DIMENSION (:,:) :: tsol, qsol, psol_dyn
	62	REAL, ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: var_ana3d
	63	!
	64	CONTAINS
	65	!
	66	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	67	!
	68	SUBROUTINE startget_phys2d(varname, iml, jml, lon_in, lat_in,
	69	. champ, val_exp, jml2, lon_in2, lat_in2 , interbar, masque_lu )
	70	!
	71	! There is a big mess with the size in logitude, should it be iml or iml+1.
	72	! I have chosen to use the iml+1 as an argument to this routine and we declare
	73	! internaly smaler fields when needed. This needs to be cleared once and for all in LMDZ.
	74	! A convention is required.
	75	!
	76	!
	77	CHARACTER(), INTENT(in) :: varname
	78	INTEGER, INTENT(in) :: iml, jml ,jml2
	79	REAL, INTENT(in) :: lon_in(iml), lat_in(jml)
	80	REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2)
	81	REAL, INTENT(inout) :: champ(iml,jml)
	82	REAL, INTENT(in) :: val_exp
	83	REAL, INTENT(in), optional :: masque_lu(iml,jml)
	84	LOGICAL interbar
	85	!
	86	! This routine only works if the variable does not exist or is constant
	87	!
	88	IF ( MINVAL(champ(:,:)).EQ.MAXVAL(champ(:,:)) .AND.
	89	.MINVAL(champ(:,:)).EQ.val_exp ) THEN
	90	!
	91	SELECTCASE(varname)
	92	!
	93	CASE ('relief')
	94	!
	95	! If we do not have the orography we need to get it
	96	!
	97	IF ( .NOT.ALLOCATED(relief)) THEN
	98	!
	99	if (present(masque_lu)) then
	100	CALL start_init_orog( iml, jml, lon_in, lat_in,
	101	. jml2,lon_in2,lat_in2, interbar, masque_lu )
	102	else
	103	CALL start_init_orog( iml, jml, lon_in, lat_in,
	104	. jml2,lon_in2,lat_in2, interbar)
	105	endif
	106	!
	107	ENDIF
	108	!
	109	IF (SIZE(relief) .NE. SIZE(champ)) THEN
	110	!
	111	WRITE(,) 'STARTVAR module has been',
	112	.' initialized to the wrong size'
	113	STOP
	114	!
	115	ENDIF
	116	!
	117	champ(:,:) = relief(:,:)
	118	!
	119	CASE ('rugosite')
	120	!
	121	! If we do not have the orography we need to get it
	122	!
	123	IF ( .NOT.ALLOCATED(rugo)) THEN
	124	!
	125	CALL start_init_orog( iml, jml, lon_in, lat_in,
	126	. jml2,lon_in2,lat_in2 , interbar )
	127	!
	128	ENDIF
	129	!
	130	IF (SIZE(rugo) .NE. SIZE(champ)) THEN
	131	!
	132	WRITE(,)
	133	. 'STARTVAR module has been initialized to the wrong size'
	134	STOP
	135	!
	136	ENDIF
	137	!
	138	champ(:,:) = rugo(:,:)
	139	!
	140	CASE ('masque')
	141	!
	142	! If we do not have the orography we need to get it
	143	!
	144	IF ( .NOT.ALLOCATED(masque)) THEN
	145	!
	146	CALL start_init_orog( iml, jml, lon_in, lat_in,
	147	. jml2,lon_in2,lat_in2 , interbar )
	148	!
	149	ENDIF
	150	!
	151	IF (SIZE(masque) .NE. SIZE(champ)) THEN
	152	!
	153	WRITE(,)
	154	. 'STARTVAR module has been initialized to the wrong size'
	155	STOP
	156	!
	157	ENDIF
	158	!
	159	champ(:,:) = masque(:,:)
	160	!
	161	CASE ('surfgeo')
	162	!
	163	! If we do not have the orography we need to get it
	164	!
	165	IF ( .NOT.ALLOCATED(phis)) THEN
	166	!
	167	CALL start_init_orog( iml, jml, lon_in, lat_in,
	168	. jml2,lon_in2, lat_in2 , interbar )
	169	!
	170	ENDIF
	171	!
	172	IF (SIZE(phis) .NE. SIZE(champ)) THEN
	173	!
	174	WRITE(,)
	175	. 'STARTVAR module has been initialized to the wrong size'
	176	STOP
	177	!
	178	ENDIF
	179	!
	180	champ(:,:) = phis(:,:)
	181	!
	182	CASE ('psol')
	183	!
	184	! If we do not have the orography we need to get it
	185	!
	186	IF ( .NOT.ALLOCATED(psol_dyn)) THEN
	187	!
	188	CALL start_init_dyn( iml, jml, lon_in, lat_in,
	189	. jml2,lon_in2, lat_in2 , interbar )
	190	!
	191	ENDIF
	192	!
	193	IF (SIZE(psol_dyn) .NE. SIZE(champ)) THEN
	194	!
	195	WRITE(,)
	196	. 'STARTVAR module has been initialized to the wrong size'
	197	STOP
	198	!
	199	ENDIF
	200	!
	201	champ(:,:) = psol_dyn(:,:)
	202	!
	203	CASE DEFAULT
	204	!
	205	WRITE(,) 'startget_phys2d'
	206	WRITE(,) 'No rule is present to extract variable',
	207	. varname(:LEN_TRIM(varname)),' from any data set'
	208	STOP
	209	!
	210	END SELECT
	211	!
	212	ELSE
	213	!
	214	! There are a few fields we might need if we need to interpolate 3D filed. Thus if they come through here we
	215	! will catch them
	216	!
	217	SELECTCASE(varname)
	218	!
	219	CASE ('surfgeo')
	220	!
	221	IF ( .NOT.ALLOCATED(phis)) THEN
	222	ALLOCATE(phis(iml,jml))
	223	ENDIF
	224	!
	225	IF (SIZE(phis) .NE. SIZE(champ)) THEN
	226	!
	227	WRITE(,)
	228	. 'STARTVAR module has been initialized to the wrong size'
	229	STOP
	230	!
	231	ENDIF
	232	!
	233	phis(:,:) = champ(:,:)
	234	!
	235	END SELECT
	236	!
	237	ENDIF
	238	!
	239	END SUBROUTINE startget_phys2d
	240	!
	241	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	242	!
	243	SUBROUTINE start_init_orog ( iml,jml,lon_in, lat_in,jml2,lon_in2 ,
	244	, lat_in2 , interbar, masque_lu )
	245	!
	246	INTEGER, INTENT(in) :: iml, jml, jml2
	247	REAL, INTENT(in) :: lon_in(iml), lat_in(jml)
	248	REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2)
	249	REAL, intent(in), optional :: masque_lu(iml,jml)
	250	LOGICAL interbar
	251	!
	252	! LOCAL
	253	!
	254	LOGICAL interbar2
	255	REAL :: lev(1), date, dt,chmin,chmax
	256	INTEGER :: itau(1), fid
	257	INTEGER :: llm_tmp, ttm_tmp
	258	INTEGER :: i, j
	259	INTEGER :: iret
	260	CHARACTER*25 title
	261	REAL, ALLOCATABLE :: relief_hi(:,:)
	262	REAL, ALLOCATABLE :: lon_rad(:), lat_rad(:)
	263	REAL, ALLOCATABLE :: lon_ini(:), lat_ini(:)
	264	REAL, ALLOCATABLE :: tmp_var(:,:)
	265	INTEGER, ALLOCATABLE :: tmp_int(:,:)
	266	!
	267	CHARACTER*120 :: orogfname
	268	LOGICAL :: check=.TRUE.
	269	!
	270	!
	271	orogfname = 'Relief.nc'
	272	!
	273	IF ( check ) WRITE(,) 'Reading the high resolution orography'
	274	!
	275	CALL flininfo(orogfname,iml_rel, jml_rel, llm_tmp, ttm_tmp, fid)
	276	!
	277	ALLOCATE (lat_rel(iml_rel,jml_rel), stat=iret)
	278	ALLOCATE (lon_rel(iml_rel,jml_rel), stat=iret)
	279	ALLOCATE (relief_hi(iml_rel,jml_rel), stat=iret)
	280	!
	281	CALL flinopen(orogfname, .FALSE., iml_rel, jml_rel,
	282	.llm_tmp, lon_rel, lat_rel, lev, ttm_tmp,
	283	. itau, date, dt, fid)
	284	!
	285	CALL flinget(fid, 'RELIEF', iml_rel, jml_rel, llm_tmp,
	286	. ttm_tmp, 1, 1, relief_hi)
	287	!
	288	CALL flinclo(fid)
	289	!
	290	! In case we have a file which is in degrees we do the transformation
	291	!
	292	ALLOCATE(lon_rad(iml_rel))
	293	ALLOCATE(lon_ini(iml_rel))
	294
	295	IF ( MAXVAL(lon_rel(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
	296	lon_ini(:) = lon_rel(:,1) * 2.0 * ASIN(1.0) / 180.0
	297	ELSE
	298	lon_ini(:) = lon_rel(:,1)
	299	ENDIF
	300
	301	ALLOCATE(lat_rad(jml_rel))
	302	ALLOCATE(lat_ini(jml_rel))
	303
	304	IF ( MAXVAL(lat_rel(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
	305	lat_ini(:) = lat_rel(1,:) * 2.0 * ASIN(1.0) / 180.0
	306	ELSE
	307	lat_ini(:) = lat_rel(1,:)
	308	ENDIF
	309	!
	310	!
	311
	312	title='RELIEF'
	313
	314	interbar2 = .FALSE.
	315	CALL conf_dat2d(title,iml_rel, jml_rel, lon_ini, lat_ini,
	316	. lon_rad, lat_rad, relief_hi , interbar2 )
	317
	318	IF ( check ) WRITE(,) 'Computes all the parameters needed',
	319	.' for the gravity wave drag code'
	320	!
	321	! Allocate the data we need to put in the interpolated fields
	322	!
	323	! RELIEF: orographie moyenne
	324	ALLOCATE(relief(iml,jml))
	325	! zphi : orographie moyenne
	326	ALLOCATE(phis(iml,jml))
	327	! zstd: deviation standard de l'orographie sous-maille
	328	ALLOCATE(zstd(iml,jml))
	329	! zsig: pente de l'orographie sous-maille
	330	ALLOCATE(zsig(iml,jml))
	331	! zgam: anisotropy de l'orographie sous maille
	332	ALLOCATE(zgam(iml,jml))
	333	! zthe: orientation de l'axe oriente dans la direction
	334	! de plus grande pente de l'orographie sous maille
	335	ALLOCATE(zthe(iml,jml))
	336	! zpic: hauteur pics de la SSO
	337	ALLOCATE(zpic(iml,jml))
	338	! zval: hauteur vallees de la SSO
	339	ALLOCATE(zval(iml,jml))
	340	! masque : Masque terre ocean
	341	ALLOCATE(tmp_int(iml,jml))
	342	ALLOCATE(masque(iml,jml))
	343
	344	masque = -99999.
	345	if (present(masque_lu)) then
	346	masque = masque_lu
	347	endif
	348	!
	349	CALL grid_noro(iml_rel, jml_rel, lon_rad, lat_rad, relief_hi,
	350	. iml-1, jml, lon_in, lat_in,
	351	. phis, relief, zstd, zsig, zgam, zthe, zpic, zval, masque)
	352	phis = phis * 9.81
	353	!
[1299]	354	! masque(:,:) = REAL(tmp_int(:,:))
[630]	355	!
	356	! Compute surface roughness
	357	!
	358	IF ( check ) WRITE(,)
	359	.'Compute surface roughness induced by the orography'
	360	!
	361	ALLOCATE(rugo(iml,jml))
	362	ALLOCATE(tmp_var(iml-1,jml))
	363	!
	364	CALL rugsoro(iml_rel, jml_rel, lon_rad, lat_rad, relief_hi,
	365	. iml-1, jml, lon_in, lat_in, tmp_var)
	366	!
	367	DO j = 1, jml
	368	DO i = 1, iml-1
	369	rugo(i,j) = tmp_var(i,j)
	370	ENDDO
	371	rugo(iml,j) = tmp_var(1,j)
	372	ENDDO
	373	c
	374	cc * rugo n'est pas utilise pour l'instant ****
	375	!
	376	! Build land-sea mask
	377	!
	378	!
	379	RETURN
	380	!
	381	END SUBROUTINE start_init_orog
	382	!
	383	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	384	!
	385	SUBROUTINE startget_phys1d(varname, iml, jml, lon_in,
	386	.lat_in, nbindex, champ, val_exp ,jml2, lon_in2, lat_in2,interbar)
	387	!
	388	CHARACTER(), INTENT(in) :: varname
	389	INTEGER, INTENT(in) :: iml, jml, nbindex, jml2
	390	REAL, INTENT(in) :: lon_in(iml), lat_in(jml)
	391	REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2)
	392	REAL, INTENT(inout) :: champ(nbindex)
	393	REAL, INTENT(in) :: val_exp
	394	LOGICAL interbar
	395	!
	396	!
	397	! This routine only works if the variable does not exist or is constant
	398	!
	399	IF ( MINVAL(champ(:)).EQ.MAXVAL(champ(:)) .AND.
	400	.MINVAL(champ(:)).EQ.val_exp ) THEN
	401	SELECTCASE(varname)
	402	CASE ('tsol')
	403	IF ( .NOT.ALLOCATED(tsol)) THEN
	404	CALL start_init_phys( iml, jml, lon_in, lat_in,
	405	. jml2, lon_in2, lat_in2, interbar )
	406	ENDIF
	407	IF ( SIZE(tsol) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
	408	WRITE(,)
	409	. 'STARTVAR module has been initialized to the wrong size'
	410	STOP
	411	ENDIF
	412	CALL gr_dyn_fi(1, iml, jml, nbindex, tsol, champ)
	413	CASE ('qsol')
	414	IF ( .NOT.ALLOCATED(qsol)) THEN
	415	CALL start_init_phys( iml, jml, lon_in, lat_in,
	416	. jml2, lon_in2,lat_in2 , interbar )
	417	ENDIF
	418	IF ( SIZE(qsol) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
	419	WRITE(,)
	420	. 'STARTVAR module has been initialized to the wrong size'
	421	STOP
	422	ENDIF
	423	CALL gr_dyn_fi(1, iml, jml, nbindex, qsol, champ)
	424	CASE ('psol')
	425	IF ( .NOT.ALLOCATED(psol_dyn)) THEN
	426	CALL start_init_dyn( iml, jml, lon_in, lat_in,
	427	. jml2, lon_in2,lat_in2 , interbar )
	428	ENDIF
	429	IF (SIZE(psol_dyn) .NE. SIZE(lon_in)*SIZE(lat_in)) THEN
	430	WRITE(,)
	431	. 'STARTVAR module has been initialized to the wrong size'
	432	STOP
	433	ENDIF
	434	CALL gr_dyn_fi(1, iml, jml, nbindex, psol_dyn, champ)
	435	CASE ('zmea')
	436	IF ( .NOT.ALLOCATED(relief)) THEN
	437	CALL start_init_orog( iml, jml, lon_in, lat_in,
	438	. jml2, lon_in2,lat_in2 , interbar )
	439	ENDIF
	440	IF ( SIZE(relief) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
	441	WRITE(,)
	442	. 'STARTVAR module has been initialized to the wrong size'
	443	STOP
	444	ENDIF
	445	CALL gr_dyn_fi(1, iml, jml, nbindex, relief, champ)
	446	CASE ('zstd')
	447	IF ( .NOT.ALLOCATED(zstd)) THEN
	448	CALL start_init_orog( iml, jml, lon_in, lat_in,
	449	. jml2, lon_in2,lat_in2 , interbar )
	450	ENDIF
	451	IF ( SIZE(zstd) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
	452	WRITE(,)
	453	. 'STARTVAR module has been initialized to the wrong size'
	454	STOP
	455	ENDIF
	456	CALL gr_dyn_fi(1, iml, jml, nbindex,zstd, champ)
	457	CASE ('zsig')
	458	IF ( .NOT.ALLOCATED(zsig)) THEN
	459	CALL start_init_orog( iml, jml, lon_in, lat_in,
	460	. jml2, lon_in2,lat_in2 , interbar )
	461	ENDIF
	462	IF ( SIZE(zsig) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
	463	WRITE(,)
	464	. 'STARTVAR module has been initialized to the wrong size'
	465	STOP
	466	ENDIF
	467	CALL gr_dyn_fi(1, iml, jml, nbindex,zsig, champ)
	468	CASE ('zgam')
	469	IF ( .NOT.ALLOCATED(zgam)) THEN
	470	CALL start_init_orog( iml, jml, lon_in, lat_in,
	471	. jml2, lon_in2,lat_in2 , interbar )
	472	ENDIF
	473	IF ( SIZE(zgam) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
	474	WRITE(,)
	475	. 'STARTVAR module has been initialized to the wrong size'
	476	STOP
	477	ENDIF
	478	CALL gr_dyn_fi(1, iml, jml, nbindex,zgam, champ)
	479	CASE ('zthe')
	480	IF ( .NOT.ALLOCATED(zthe)) THEN
	481	CALL start_init_orog( iml, jml, lon_in, lat_in,
	482	. jml2, lon_in2,lat_in2 , interbar )
	483	ENDIF
	484	IF ( SIZE(zthe) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
	485	WRITE(,)
	486	. 'STARTVAR module has been initialized to the wrong size'
	487	STOP
	488	ENDIF
	489	CALL gr_dyn_fi(1, iml, jml, nbindex,zthe, champ)
	490	CASE ('zpic')
	491	IF ( .NOT.ALLOCATED(zpic)) THEN
	492	CALL start_init_orog( iml, jml, lon_in, lat_in,
	493	. jml2, lon_in2,lat_in2 , interbar )
	494	ENDIF
	495	IF ( SIZE(zpic) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
	496	WRITE(,)
	497	. 'STARTVAR module has been initialized to the wrong size'
	498	STOP
	499	ENDIF
	500	CALL gr_dyn_fi(1, iml, jml, nbindex,zpic, champ)
	501	CASE ('zval')
	502	IF ( .NOT.ALLOCATED(zval)) THEN
	503	CALL start_init_orog( iml, jml, lon_in, lat_in,
	504	. jml2, lon_in2,lat_in2 , interbar )
	505	ENDIF
	506	IF ( SIZE(zval) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
	507	WRITE(,)
	508	. 'STARTVAR module has been initialized to the wrong size'
	509	STOP
	510	ENDIF
	511	CALL gr_dyn_fi(1, iml, jml, nbindex,zval, champ)
	512	CASE ('rads')
	513	champ(:) = 0.0
	514	CASE ('snow')
	515	champ(:) = 0.0
[1000]	516	cIM "slab" ocean
	517	CASE ('tslab')
	518	champ(:) = 0.0
	519	CASE ('seaice')
[630]	520	champ(:) = 0.0
	521	CASE ('rugmer')
	522	champ(:) = 0.001
	523	CASE ('agsno')
	524	champ(:) = 50.0
	525	CASE DEFAULT
	526	WRITE(,) 'startget_phys1d'
	527	WRITE(,) 'No rule is present to extract variable ',
	528	. varname(:LEN_TRIM(varname)),' from any data set'
	529	STOP
	530	END SELECT
	531	ELSE
	532	!
	533	! If we see tsol we catch it as we may need it for a 3D interpolation
	534	!
	535	SELECTCASE(varname)
	536	CASE ('tsol')
	537	IF ( .NOT.ALLOCATED(tsol)) THEN
	538	ALLOCATE(tsol(SIZE(lon_in),SIZE(lat_in) ))
	539	ENDIF
	540	CALL gr_fi_dyn(1, iml, jml, nbindex, champ, tsol)
	541	END SELECT
	542	ENDIF
	543	END SUBROUTINE startget_phys1d
	544	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	545	!
	546	SUBROUTINE start_init_phys( iml, jml, lon_in, lat_in, jml2,
	547	. lon_in2, lat_in2 , interbar )
[1293]	548
	549	use inter_barxy_m, only: inter_barxy
[630]	550	!
	551	INTEGER, INTENT(in) :: iml, jml ,jml2
	552	REAL, INTENT(in) :: lon_in(iml), lat_in(jml)
	553	REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2)
	554	LOGICAL interbar
	555	!
	556	! LOCAL
	557	!
	558	!ac REAL :: lev(1), date, dt
	559	REAL :: date, dt
	560	REAL, DIMENSION(:), ALLOCATABLE :: levphys_ini
	561	!ac
	562	INTEGER :: itau(1)
	563	INTEGER :: llm_tmp, ttm_tmp
	564	INTEGER :: i, j
	565	!
	566	CHARACTER*25 title
	567	CHARACTER*120 :: physfname
	568	LOGICAL :: check=.TRUE.
	569	!
	570	REAL, ALLOCATABLE :: lon_rad(:), lat_rad(:)
	571	REAL, ALLOCATABLE :: lon_ini(:), lat_ini(:)
	572	REAL, ALLOCATABLE :: var_ana(:,:), tmp_var(:,:)
	573	!
	574	physfname = 'ECPHY.nc'
	575	!
	576	IF ( check ) WRITE(,) 'Opening the surface analysis'
	577	!
	578	CALL flininfo(physfname, iml_phys, jml_phys, llm_tmp,
	579	. ttm_tmp, fid_phys)
	580	!
	581	ALLOCATE (lat_phys(iml_phys,jml_phys))
	582	ALLOCATE (lon_phys(iml_phys,jml_phys))
	583	!ac
	584	ALLOCATE (levphys_ini(llm_tmp))
	585	!
	586	! CALL flinopen(physfname, .FALSE., iml_phys, jml_phys,
	587	! . llm_tmp, lon_phys, lat_phys, lev, ttm_tmp,
	588	! . itau, date, dt, fid_phys)
	589	!
	590	CALL flinopen(physfname, .FALSE., iml_phys, jml_phys,
	591	. llm_tmp, lon_phys, lat_phys, levphys_ini, ttm_tmp,
	592	. itau, date, dt, fid_phys)
	593	!
	594	DEALLOCATE (levphys_ini)
	595	!ac
	596	!
	597	! Allocate the space we will need to get the data out of this file
	598	!
	599	ALLOCATE(var_ana(iml_phys, jml_phys))
	600	!
	601	! In case we have a file which is in degrees we do the transformation
	602	!
	603	ALLOCATE(lon_rad(iml_phys))
	604	ALLOCATE(lon_ini(iml_phys))
	605
	606	IF ( MAXVAL(lon_phys(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
	607	lon_ini(:) = lon_phys(:,1) * 2.0 * ASIN(1.0) / 180.0
	608	ELSE
	609	lon_ini(:) = lon_phys(:,1)
	610	ENDIF
	611
	612	ALLOCATE(lat_rad(jml_phys))
	613	ALLOCATE(lat_ini(jml_phys))
	614
	615	IF ( MAXVAL(lat_phys(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
	616	lat_ini(:) = lat_phys(1,:) * 2.0 * ASIN(1.0) / 180.0
	617	ELSE
	618	lat_ini(:) = lat_phys(1,:)
	619	ENDIF
	620
	621
	622	!
	623	! We get the two standard varibales
	624	! Surface temperature
	625	!
	626	ALLOCATE(tsol(iml,jml))
	627	ALLOCATE(tmp_var(iml-1,jml))
	628	!
	629	!
	630
	631	CALL flinget(fid_phys, 'ST', iml_phys, jml_phys,
	632	.llm_tmp, ttm_tmp, 1, 1, var_ana)
	633
	634	title='ST'
	635	CALL conf_dat2d(title,iml_phys, jml_phys, lon_ini, lat_ini,
	636	. lon_rad, lat_rad, var_ana , interbar )
	637
	638	IF ( interbar ) THEN
	639	WRITE(6,*) '-------------------------------------------------',
	640	,'--------------'
	641	WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
	642	, ' pour ST $$$ '
	643	WRITE(6,*) '-------------------------------------------------',
	644	,'--------------'
[1293]	645	CALL inter_barxy(lon_rad, lat_rad(:jml_phys -1), var_ana,
	646	$ lon_in2(:iml-1), lat_in2(:jml-1), tmp_var)
[630]	647	ELSE
	648	CALL grille_m(iml_phys, jml_phys, lon_rad, lat_rad,
	649	. var_ana, iml-1, jml, lon_in, lat_in, tmp_var )
	650	ENDIF
	651
	652	CALL gr_int_dyn(tmp_var, tsol, iml-1, jml)
	653	!
	654	! Soil moisture
	655	!
	656	ALLOCATE(qsol(iml,jml))
	657	CALL flinget(fid_phys, 'CDSW', iml_phys, jml_phys,
	658	. llm_tmp, ttm_tmp, 1, 1, var_ana)
	659
	660	title='CDSW'
	661	CALL conf_dat2d(title,iml_phys, jml_phys, lon_ini, lat_ini,
	662	. lon_rad, lat_rad, var_ana, interbar )
	663
	664	IF ( interbar ) THEN
	665	WRITE(6,*) '-------------------------------------------------',
	666	,'--------------'
	667	WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
	668	, ' pour CDSW $$$ '
	669	WRITE(6,*) '-------------------------------------------------',
	670	,'--------------'
[1293]	671	CALL inter_barxy(lon_rad, lat_rad(:jml_phys -1), var_ana,
	672	$ lon_in2(:iml-1), lat_in2(:jml-1), tmp_var)
[630]	673	ELSE
	674	CALL grille_m(iml_phys, jml_phys, lon_rad, lat_rad,
	675	. var_ana, iml-1, jml, lon_in, lat_in, tmp_var )
	676	ENDIF
	677	c
	678	CALL gr_int_dyn(tmp_var, qsol, iml-1, jml)
	679	!
	680	CALL flinclo(fid_phys)
	681	!
	682	END SUBROUTINE start_init_phys
	683	!
	684	!
	685	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	686	!
	687	!
[1293]	688	SUBROUTINE startget_dyn(varname, lon_in, lat_in,
	689	. pls, workvar, champ, val_exp, lon_in2, lat_in2 ,
[630]	690	, interbar )
[1293]	691
	692	use assert_eq_m, only: assert_eq
[630]	693	!
	694	! ARGUMENTS
	695	!
[1293]	696	CHARACTER(len=*), INTENT(in) :: varname
	697	REAL, INTENT(in) :: lon_in(:) ! dim(iml)
	698	REAL, INTENT(in) :: lat_in(:) ! dim(jml)
	699	REAL, INTENT(in) :: lon_in2(:) ! dim(iml)
	700	REAL, INTENT(in) :: lat_in2(:) ! dim(jml2)
	701	REAL, INTENT(in) :: pls(:, :, :) ! dim(iml, jml, lml)
	702	REAL, INTENT(in) :: workvar(:, :, :) ! dim(iml, jml, lml)
	703	REAL, INTENT(inout) :: champ(:, :, :) ! dim(iml, jml, lml)
[630]	704	REAL, INTENT(in) :: val_exp
	705	LOGICAL interbar
	706	!
	707	! LOCAL
	708	!
[1293]	709	INTEGER :: il, ij, ii, iml, jml, lml, jml2
[630]	710	REAL :: xppn, xpps
	711	!
	712	#include "dimensions.h"
	713	#include "paramet.h"
	714	#include "comgeom2.h"
	715	#include "comconst.h"
	716	!
	717	! This routine only works if the variable does not exist or is constant
	718	!
[1293]	719	C -----------------------------
	720
	721	iml = assert_eq((/size(lon_in), size(pls, 1), size(workvar, 1),
	722	$ size(champ, 1), size(lon_in2)/), "startget_dyn iml")
	723	jml = assert_eq(size(lat_in), size(pls, 2), size(workvar, 2),
	724	$ size(champ, 2), "startget_dyn jml")
	725	lml = assert_eq(size(pls, 3), size(workvar, 3), size(champ, 3),
	726	$ "startget_dyn lml")
	727	jml2 = size(lat_in2)
	728
[630]	729	IF ( MINVAL(champ(:,:,:)).EQ.MAXVAL(champ(:,:,:)) .AND.
	730	. MINVAL(champ(:,:,:)).EQ.val_exp ) THEN
	731	!
	732	SELECTCASE(varname)
	733	CASE ('u')
	734	IF ( .NOT.ALLOCATED(psol_dyn)) THEN
	735	CALL start_init_dyn( iml, jml, lon_in, lat_in, jml2 ,
	736	. lon_in2,lat_in2 , interbar )
	737	ENDIF
	738	CALL start_inter_3d('U', iml, jml, lml, lon_in,
	739	. lat_in, jml2, lon_in2, lat_in2, pls, champ,interbar )
	740	DO il=1,lml
	741	DO ij=1,jml
	742	DO ii=1,iml-1
	743	champ(ii,ij,il) = champ(ii,ij,il) * cu(ii,ij)
	744	ENDDO
	745	champ(iml,ij, il) = champ(1,ij, il)
	746	ENDDO
	747	ENDDO
	748	CASE ('v')
	749	IF ( .NOT.ALLOCATED(psol_dyn)) THEN
	750	CALL start_init_dyn( iml, jml, lon_in, lat_in , jml2,
	751	. lon_in2, lat_in2 , interbar )
	752	ENDIF
	753	CALL start_inter_3d('V', iml, jml, lml, lon_in,
	754	. lat_in, jml2, lon_in2, lat_in2, pls, champ, interbar )
	755	DO il=1,lml
	756	DO ij=1,jml
	757	DO ii=1,iml-1
	758	champ(ii,ij,il) = champ(ii,ij,il) * cv(ii,ij)
	759	ENDDO
	760	champ(iml,ij, il) = champ(1,ij, il)
	761	ENDDO
	762	ENDDO
	763	CASE ('t')
	764	IF ( .NOT.ALLOCATED(psol_dyn)) THEN
	765	CALL start_init_dyn( iml, jml, lon_in, lat_in, jml2 ,
	766	. lon_in2, lat_in2 ,interbar )
	767	ENDIF
	768	CALL start_inter_3d('TEMP', iml, jml, lml, lon_in,
	769	. lat_in, jml2, lon_in2, lat_in2, pls, champ, interbar )
	770
	771	CASE ('tpot')
	772	IF ( .NOT.ALLOCATED(psol_dyn)) THEN
	773	CALL start_init_dyn( iml, jml, lon_in, lat_in , jml2 ,
	774	. lon_in2, lat_in2 , interbar )
	775	ENDIF
	776	CALL start_inter_3d('TEMP', iml, jml, lml, lon_in,
	777	. lat_in, jml2, lon_in2, lat_in2, pls, champ, interbar )
	778	IF ( MINVAL(workvar(:,:,:)) .NE. MAXVAL(workvar(:,:,:)) )
	779	. THEN
	780	DO il=1,lml
	781	DO ij=1,jml
	782	DO ii=1,iml-1
	783	champ(ii,ij,il) = champ(ii,ij,il) * cpp
	784	. / workvar(ii,ij,il)
	785	ENDDO
	786	champ(iml,ij,il) = champ(1,ij,il)
	787	ENDDO
	788	ENDDO
	789	DO il=1,lml
	790	xppn = SUM(aire(:,1)*champ(:,1,il))/apoln
	791	xpps = SUM(aire(:,jml)*champ(:,jml,il))/apols
	792	champ(:,1,il) = xppn
	793	champ(:,jml,il) = xpps
	794	ENDDO
	795	ELSE
	796	WRITE(,)'Could not compute potential temperature as the'
	797	WRITE(,)'Exner function is missing or constant.'
	798	STOP
	799	ENDIF
	800	CASE ('q')
	801	IF ( .NOT.ALLOCATED(psol_dyn)) THEN
	802	CALL start_init_dyn( iml, jml, lon_in, lat_in, jml2 ,
	803	. lon_in2, lat_in2 , interbar )
	804	ENDIF
	805	CALL start_inter_3d('R', iml, jml, lml, lon_in, lat_in,
	806	. jml2, lon_in2, lat_in2, pls, champ, interbar )
	807	IF ( MINVAL(workvar(:,:,:)) .NE. MAXVAL(workvar(:,:,:)) )
	808	. THEN
	809	DO il=1,lml
	810	DO ij=1,jml
	811	DO ii=1,iml-1
	812	champ(ii,ij,il) = 0.01 * champ(ii,ij,il) *
	813	. workvar(ii,ij,il)
	814	ENDDO
	815	champ(iml,ij,il) = champ(1,ij,il)
	816	ENDDO
	817	ENDDO
	818	WHERE ( champ .LT. 0.) champ = 1.0E-10
	819	DO il=1,lml
	820	xppn = SUM(aire(:,1)*champ(:,1,il))/apoln
	821	xpps = SUM(aire(:,jml)*champ(:,jml,il))/apols
	822	champ(:,1,il) = xppn
	823	champ(:,jml,il) = xpps
	824	ENDDO
	825	ELSE
	826	WRITE(,)'Could not compute specific humidity as the'
	827	WRITE(,)'saturated humidity is missing or constant.'
	828	STOP
	829	ENDIF
	830	CASE DEFAULT
	831	WRITE(,) 'startget_dyn'
	832	WRITE(,) 'No rule is present to extract variable ',
	833	. varname(:LEN_TRIM(varname)),' from any data set'
	834	STOP
	835	END SELECT
	836	ENDIF
	837	END SUBROUTINE startget_dyn
	838	!
	839	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	840	!
	841	SUBROUTINE start_init_dyn( iml, jml, lon_in, lat_in,jml2,lon_in2 ,
	842	, lat_in2 , interbar )
	843	!
[1293]	844	use inter_barxy_m, only: inter_barxy
	845
[630]	846	INTEGER, INTENT(in) :: iml, jml, jml2
	847	REAL, INTENT(in) :: lon_in(iml), lat_in(jml)
	848	REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2)
	849	LOGICAL interbar
	850	!
	851	! LOCAL
	852	!
	853	REAL :: lev(1), date, dt
	854	INTEGER :: itau(1)
	855	INTEGER :: i, j
	856	integer :: iret
	857	!
	858	CHARACTER*120 :: physfname
	859	LOGICAL :: check=.TRUE.
	860	!
	861	REAL, ALLOCATABLE :: lon_rad(:), lat_rad(:)
	862	REAL, ALLOCATABLE :: lon_ini(:), lat_ini(:)
	863	REAL, ALLOCATABLE :: var_ana(:,:), tmp_var(:,:), z(:,:)
	864	REAL, ALLOCATABLE :: xppn(:), xpps(:)
	865	LOGICAL :: allo
	866	!
	867	!
	868	#include "dimensions.h"
	869	#include "paramet.h"
	870	#include "comgeom2.h"
	871
	872	CHARACTER*25 title
	873
	874	!
	875	physfname = 'ECDYN.nc'
	876	!
	877	IF ( check ) WRITE(,) 'Opening the surface analysis'
	878	!
	879	CALL flininfo(physfname, iml_dyn, jml_dyn, llm_dyn,
	880	. ttm_dyn, fid_dyn)
	881	IF ( check ) WRITE(,) 'Values read: ', iml_dyn, jml_dyn,
	882	. llm_dyn, ttm_dyn
	883	!
	884	ALLOCATE (lat_dyn(iml_dyn,jml_dyn), stat=iret)
	885	ALLOCATE (lon_dyn(iml_dyn,jml_dyn), stat=iret)
	886	ALLOCATE (levdyn_ini(llm_dyn), stat=iret)
	887	!
	888	CALL flinopen(physfname, .FALSE., iml_dyn, jml_dyn, llm_dyn,
	889	. lon_dyn, lat_dyn, levdyn_ini, ttm_dyn,
	890	. itau, date, dt, fid_dyn)
	891	!
	892
	893	allo = allocated (var_ana)
	894	if (allo) then
	895	DEALLOCATE(var_ana, stat=iret)
	896	endif
	897	ALLOCATE(var_ana(iml_dyn, jml_dyn), stat=iret)
	898
	899	allo = allocated (lon_rad)
	900	if (allo) then
	901	DEALLOCATE(lon_rad, stat=iret)
	902	endif
	903
	904	ALLOCATE(lon_rad(iml_dyn), stat=iret)
	905	ALLOCATE(lon_ini(iml_dyn))
	906
	907	IF ( MAXVAL(lon_dyn(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
	908	lon_ini(:) = lon_dyn(:,1) * 2.0 * ASIN(1.0) / 180.0
	909	ELSE
	910	lon_ini(:) = lon_dyn(:,1)
	911	ENDIF
	912
	913	ALLOCATE(lat_rad(jml_dyn))
	914	ALLOCATE(lat_ini(jml_dyn))
	915
	916	IF ( MAXVAL(lat_dyn(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
	917	lat_ini(:) = lat_dyn(1,:) * 2.0 * ASIN(1.0) / 180.0
	918	ELSE
	919	lat_ini(:) = lat_dyn(1,:)
	920	ENDIF
	921	!
	922
	923
	924	ALLOCATE(z(iml, jml))
	925	ALLOCATE(tmp_var(iml-1,jml))
	926	!
	927	CALL flinget(fid_dyn, 'Z', iml_dyn, jml_dyn, 0, ttm_dyn,
	928	. 1, 1, var_ana)
	929	c
	930	title='Z'
	931	CALL conf_dat2d( title,iml_dyn, jml_dyn,lon_ini, lat_ini,
	932	. lon_rad, lat_rad, var_ana, interbar )
	933	c
	934	IF ( interbar ) THEN
	935	WRITE(6,*) '-------------------------------------------------',
	936	,'--------------'
	937	WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
	938	, ' pour Z $$$ '
	939	WRITE(6,*) '-------------------------------------------------',
	940	,'--------------'
[1293]	941	CALL inter_barxy(lon_rad, lat_rad(:jml_dyn -1), var_ana,
	942	$ lon_in2(:iml-1), lat_in2(:jml-1), tmp_var)
[630]	943	ELSE
	944	CALL grille_m(iml_dyn, jml_dyn , lon_rad, lat_rad, var_ana,
	945	. iml-1, jml, lon_in, lat_in, tmp_var)
	946	ENDIF
	947
	948	CALL gr_int_dyn(tmp_var, z, iml-1, jml)
	949	!
	950	ALLOCATE(psol_dyn(iml, jml))
	951	!
	952	CALL flinget(fid_dyn, 'SP', iml_dyn, jml_dyn, 0, ttm_dyn,
	953	. 1, 1, var_ana)
	954
	955	title='SP'
	956	CALL conf_dat2d( title,iml_dyn, jml_dyn,lon_ini, lat_ini,
	957	. lon_rad, lat_rad, var_ana, interbar )
	958
	959	IF ( interbar ) THEN
	960	WRITE(6,*) '-------------------------------------------------',
	961	,'--------------'
	962	WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
	963	, ' pour SP $$$ '
	964	WRITE(6,*) '-------------------------------------------------',
	965	,'--------------'
[1293]	966	CALL inter_barxy(lon_rad, lat_rad(:jml_dyn -1), var_ana,
	967	$ lon_in2(:iml-1), lat_in2(:jml-1), tmp_var)
[630]	968	ELSE
	969	CALL grille_m(iml_dyn, jml_dyn , lon_rad, lat_rad, var_ana,
	970	. iml-1, jml, lon_in, lat_in, tmp_var )
	971	ENDIF
	972
	973	CALL gr_int_dyn(tmp_var, psol_dyn, iml-1, jml)
	974	!
	975	IF ( .NOT.ALLOCATED(tsol)) THEN
	976	! These variables may have been allocated by the need to
	977	! create a start field for them or by the varibale
	978	! coming out of the restart file. In case we dor have it we will initialize it.
	979	!
	980	CALL start_init_phys( iml, jml, lon_in, lat_in,jml2,lon_in2,
	981	. lat_in2 , interbar )
	982	ELSE
	983	IF ( SIZE(tsol) .NE. SIZE(psol_dyn) ) THEN
	984	WRITE(,) 'start_init_dyn :'
	985	WRITE(,) 'The temperature field we have does not ',
	986	. 'have the right size'
	987	STOP
	988	ENDIF
	989	ENDIF
	990	IF ( .NOT.ALLOCATED(phis)) THEN
	991	!
	992	! These variables may have been allocated by the need to create a start field for them or by the varibale
	993	! coming out of the restart file. In case we dor have it we will initialize it.
	994	!
	995	CALL start_init_orog( iml, jml, lon_in, lat_in, jml2, lon_in2 ,
	996	. lat_in2 , interbar )
	997	!
	998	ELSE
	999	!
	1000	IF (SIZE(phis) .NE. SIZE(psol_dyn)) THEN
	1001	!
	1002	WRITE(,) 'start_init_dyn :'
	1003	WRITE(,) 'The orography field we have does not ',
	1004	. ' have the right size'
	1005	STOP
	1006	ENDIF
	1007	!
	1008	ENDIF
	1009	!
	1010	! PSOL is computed in Pascals
	1011	!
	1012	!
	1013	DO j = 1, jml
	1014	DO i = 1, iml-1
	1015	psol_dyn(i,j) = psol_dyn(i,j)*(1.0+(z(i,j)-phis(i,j))
	1016	. /287.0/tsol(i,j))
	1017	ENDDO
	1018	psol_dyn(iml,j) = psol_dyn(1,j)
	1019	ENDDO
	1020	!
	1021	!
	1022	ALLOCATE(xppn(iml-1))
	1023	ALLOCATE(xpps(iml-1))
	1024	!
	1025	DO i = 1, iml-1
	1026	xppn(i) = aire( i,1) * psol_dyn( i,1)
	1027	xpps(i) = aire( i,jml) * psol_dyn( i,jml)
	1028	ENDDO
	1029	!
	1030	DO i = 1, iml
	1031	psol_dyn(i,1 ) = SUM(xppn)/apoln
	1032	psol_dyn(i,jml) = SUM(xpps)/apols
	1033	ENDDO
	1034	!
	1035	RETURN
	1036	!
	1037	END SUBROUTINE start_init_dyn
	1038	!
	1039	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	1040	!
	1041	SUBROUTINE start_inter_3d(varname, iml, jml, lml, lon_in,
	1042	. lat_in, jml2, lon_in2, lat_in2, pls_in, var3d, interbar )
	1043	!
	1044	! This subroutine gets a variables from a 3D file and does the interpolations needed
	1045	!
	1046	!
[1293]	1047	use inter_barxy_m, only: inter_barxy
	1048
[630]	1049	! ARGUMENTS
	1050	!
	1051	CHARACTER() :: varname
	1052	INTEGER :: iml, jml, lml, jml2
	1053	REAL :: lon_in(iml), lat_in(jml), pls_in(iml, jml, lml)
	1054	REAL :: lon_in2(iml) , lat_in2(jml2)
	1055	REAL :: var3d(iml, jml, lml)
	1056	LOGICAL interbar
	1057	real chmin,chmax
	1058	!
	1059	! LOCAL
	1060	!
	1061	CHARACTER*25 title
	1062	INTEGER :: ii, ij, il, jsort,i,j,l
	1063	REAL :: bx, by
	1064	REAL, ALLOCATABLE :: lon_rad(:), lat_rad(:)
	1065	REAL, ALLOCATABLE :: lon_ini(:), lat_ini(:) , lev_dyn(:)
	1066	REAL, ALLOCATABLE :: var_tmp2d(:,:), var_tmp3d(:,:,:)
	1067	REAL, ALLOCATABLE :: ax(:), ay(:), yder(:)
[1000]	1068	! REAL, ALLOCATABLE :: varrr(:,:,:)
[630]	1069	INTEGER, ALLOCATABLE :: lind(:)
	1070	!
	1071	LOGICAL :: check = .TRUE.
	1072	!
	1073	IF ( .NOT. ALLOCATED(var_ana3d)) THEN
	1074	ALLOCATE(var_ana3d(iml_dyn, jml_dyn, llm_dyn))
	1075	ENDIF
[1000]	1076	! ALLOCATE(varrr(iml_dyn, jml_dyn, llm_dyn))
[630]	1077	!
	1078	!
	1079	IF ( check) WRITE(,) 'Going into flinget to extract the 3D ',
	1080	. ' field.', fid_dyn
	1081	IF ( check) WRITE(,) fid_dyn, varname, iml_dyn, jml_dyn,
	1082	. llm_dyn,ttm_dyn
	1083	!
	1084	CALL flinget(fid_dyn, varname, iml_dyn, jml_dyn, llm_dyn,
	1085	. ttm_dyn, 1, 1, var_ana3d)
	1086	!
	1087	IF ( check) WRITE(,) 'Allocating space for the interpolation',
	1088	. iml, jml, llm_dyn
	1089	!
	1090	ALLOCATE(lon_rad(iml_dyn))
	1091	ALLOCATE(lon_ini(iml_dyn))
	1092
	1093	IF ( MAXVAL(lon_dyn(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
	1094	lon_ini(:) = lon_dyn(:,1) * 2.0 * ASIN(1.0) / 180.0
	1095	ELSE
	1096	lon_ini(:) = lon_dyn(:,1)
	1097	ENDIF
	1098
	1099	ALLOCATE(lat_rad(jml_dyn))
	1100	ALLOCATE(lat_ini(jml_dyn))
	1101
	1102	ALLOCATE(lev_dyn(llm_dyn))
	1103
	1104	IF ( MAXVAL(lat_dyn(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
	1105	lat_ini(:) = lat_dyn(1,:) * 2.0 * ASIN(1.0) / 180.0
	1106	ELSE
	1107	lat_ini(:) = lat_dyn(1,:)
	1108	ENDIF
	1109	!
	1110
	1111	CALL conf_dat3d ( varname,iml_dyn, jml_dyn, llm_dyn, lon_ini,
	1112	. lat_ini, levdyn_ini, lon_rad, lat_rad, lev_dyn, var_ana3d ,
	1113	, interbar )
	1114
	1115	ALLOCATE(var_tmp2d(iml-1, jml))
	1116	ALLOCATE(var_tmp3d(iml, jml, llm_dyn))
	1117	ALLOCATE(ax(llm_dyn))
	1118	ALLOCATE(ay(llm_dyn))
	1119	ALLOCATE(yder(llm_dyn))
	1120	ALLOCATE(lind(llm_dyn))
	1121	!
	1122
	1123	DO il=1,llm_dyn
	1124	!
	1125	IF( interbar ) THEN
	1126	IF( il.EQ.1 ) THEN
	1127	WRITE(6,*) '-------------------------------------------------',
	1128	,'--------------'
	1129	WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
	1130	, ' pour ', varname
	1131	WRITE(6,*) '-------------------------------------------------',
	1132	,'--------------'
	1133	ENDIF
[1293]	1134	CALL inter_barxy(lon_rad, lat_rad(:jml_dyn -1),
	1135	$ var_ana3d(:,:,il), lon_in2(:iml-1), lat_in2, var_tmp2d)
[630]	1136	ELSE
	1137	CALL grille_m(iml_dyn, jml_dyn, lon_rad, lat_rad,
	1138	. var_ana3d(:,:,il), iml-1, jml, lon_in, lat_in, var_tmp2d )
	1139	ENDIF
	1140	!
	1141	CALL gr_int_dyn(var_tmp2d, var_tmp3d(:,:,il), iml-1, jml)
	1142	!
	1143	ENDDO
	1144	!
	1145	DO il=1,llm_dyn
	1146	lind(il) = llm_dyn-il+1
	1147	ENDDO
	1148	!
	1149	c
	1150	c ... Pour l'interpolation verticale ,on interpole du haut de l'atmosphere
	1151	c vers le sol ...
	1152	c
	1153	DO ij=1,jml
	1154	DO ii=1,iml-1
	1155	!
	1156	ax(:) = lev_dyn(lind(:))
	1157	ay(:) = var_tmp3d(ii, ij, lind(:))
	1158	!
	1159
	1160	CALL SPLINE(ax, ay, llm_dyn, 1.e30, 1.e30, yder)
	1161	!
	1162	DO il=1,lml
	1163	bx = pls_in(ii, ij, il)
	1164	CALL SPLINT(ax, ay, yder, llm_dyn, bx, by)
	1165	var3d(ii, ij, il) = by
	1166	ENDDO
	1167	!
	1168	ENDDO
	1169	var3d(iml, ij, :) = var3d(1, ij, :)
	1170	ENDDO
	1171
	1172	do il=1,lml
	1173	call minmax(iml*jml,var3d(1,1,il),chmin,chmax)
	1174	SELECTCASE(varname)
	1175	CASE('U')
	1176	WRITE(,) ' U min max l ',il,chmin,chmax
	1177	CASE('V')
	1178	WRITE(,) ' V min max l ',il,chmin,chmax
	1179	CASE('TEMP')
	1180	WRITE(,) ' TEMP min max l ',il,chmin,chmax
	1181	CASE('R')
	1182	WRITE(,) ' R min max l ',il,chmin,chmax
	1183	END SELECT
	1184	enddo
	1185
	1186	DEALLOCATE(lon_rad)
[1000]	1187	DEALLOCATE(lon_ini)
[630]	1188	DEALLOCATE(lat_rad)
[1000]	1189	DEALLOCATE(lat_ini)
	1190	DEALLOCATE(lev_dyn)
[630]	1191	DEALLOCATE(var_tmp2d)
	1192	DEALLOCATE(var_tmp3d)
	1193	DEALLOCATE(ax)
	1194	DEALLOCATE(ay)
	1195	DEALLOCATE(yder)
	1196	DEALLOCATE(lind)
	1197
	1198	!
	1199	RETURN
	1200	!
	1201	END SUBROUTINE start_inter_3d
	1202	!
[1279]	1203	#endif
	1204	! of #ifdef CPP_EARTH
[630]	1205	END MODULE startvar

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

Download in other formats:

Original Format