Context Navigation

ecumev6_flux.F90 @ 5442

Last change on this file since 5442 was 5144, checked in by abarral, 6 months ago
Put YOMCST.h into modules
File size: 29.3 KB

Rev	Line
[4661]	1	!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
	2	!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
	3	!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
	4	!SFX_LIC for details. version 1.
	5	! #########
[5144]	6	SUBROUTINE ECUMEV6_FLUX(PZ0SEA, PTA, PSST, PQA, PQSAT, PVMOD, &
	7	PZREF, PSSS, PUREF, PPS, PPA, OPRECIP, OPWEBB, &
	8	PSFTH, PSFTQ, PUSTAR, PCD, PCDN, PCH, PCE, &
	9	PRI, PRESA, PRAIN, PZ0HSEA, OPERTFLUX, coeffs)
	10	!###############################################################################
	11	!!
	12	!!**** ECUMEV6_FLUX
	13	!!
	14	!! PURPOSE
	15	!! -------
	16	! Calculate the surface turbulent fluxes of heat, moisture, and momentum
	17	! over sea surface + corrections due to rainfall & Webb effect.
	18	!!
	19	!!** METHOD
	20	!! ------
	21	! The estimation of the transfer coefficients relies on the iterative
	22	! computation of the scaling parameters U/Teta/q*. The convergence is
	23	! supposed to be reached in NITERFL iterations maximum.
	24	! Neutral transfer coefficients for momentum/temperature/humidity
	25	! are computed as a function of the 10m-height neutral wind speed using
	26	! the ECUME_V6 formulation based on the multi-campaign (POMME,FETCH,CATCH,
	27	! SEMAPHORE,EQUALANT) ALBATROS dataset.
	28	!!
	29	!! EXTERNAL
	30	!! --------
	31	!!
	32	!! IMPLICIT ARGUMENTS
	33	!! ------------------
	34	!!
	35	!! REFERENCE
	36	!! ---------
	37	!! Fairall et al (1996), JGR, 3747-3764
	38	!! Gosnell et al (1995), JGR, 437-442
	39	!! Fairall et al (1996), JGR, 1295-1308
	40	!!
	41	!! AUTHOR
	42	!! ------
	43	!! C. Lebeaupin Météo-France (adapted from S. Belamari's code)
	44	!!
	45	!! MODIFICATIONS
	46	!! -------------
	47	!! Original 15/03/2005
	48	!! Modified 01/2006 C. Lebeaupin (adapted from A. Pirani's code)
	49	!! Modified 08/2009 B. Decharme: limitation of Ri
	50	!! Modified 09/2012 B. Decharme: CD correction
	51	!! Modified 09/2012 B. Decharme: limitation of Ri in surface_ri.F90
	52	!! Modified 10/2012 P. Le Moigne: extra inputs for FLake use
	53	!! Modified 06/2013 B. Decharme: bug in z0 (output) computation
	54	!! Modified 12/2013 S. Belamari: ZRF computation updated:
	55	!! 1. ZP00/PPA in ZDWAT, ZLVA in ZDQSDT/ZBULB/ZRF
	56	!! 2. ZDWAT/ZDTMP in ZBULB/ZRF (Gosnell et al 95)
	57	!! 3. cool skin correction included
	58	!! Modified 01/2014 S. Belamari: salinity impact on latent heat of
	59	!! vaporization of seawater included
	60	!! Modified 01/2014 S. Belamari: new formulation for pure water
	61	!! specific heat (ZCPWA)
	62	!! Modified 01/2014 S. Belamari: 4 choices for PZ0SEA computation
	63	!! Modified 12/2015 S. Belamari: ECUME now provides parameterisations
	64	!! for: U10n*sqrt(CDN) instead of CDN
	65	!! U10n*CHN/sqrt(CDN) " CHN
	66	!! U10n*CEN/sqrt(CDN) " CEN
	67	!! Modified 01/2016 S. Belamari: New ECUME formulation
	68	!!
	69	!! To be done:
	70	!! include gustiness computation following Mondon & Redelsperger (1998)
	71	!!!
	72	!-------------------------------------------------------------------------------
	73	!!
	74	!! MODIFICATIONS RELATED TO SST CORRECTION COMPUTATION
	75	!! ---------------------------------------------------
	76	!! Modified 09/2013 S. Belamari: use 0.98 for the ocean emissivity
	77	!! following up to date satellite measurements in
	78	!! the 8-14 μm range (obtained values range from
	79	!! 0.98 to 0.99).
	80	!!!
	81	!-------------------------------------------------------------------------------
[5099]	82
[5144]	83	! 0. DECLARATIONS
	84	! ------------
[5099]	85
[5144]	86	USE dimphy
	87	USE indice_sol_mod
	88	USE MODD_CSTS, ONLY: XPI, XDAY, XKARMAN, XG, XP00, XSTEFAN, XRD, XRV, &
	89	XCPD, XCPV, XCL, XTT, XLVTT
	90	USE lmdz_clesphys
	91	USE lmdz_yomcst
[4661]	92
	93
[5144]	94	!USE MODD_SURF_PAR, ONLY: XUNDEF
	95	!USE MODD_SURF_ATM, ONLY: XVCHRNK, XVZ0CM
	96	!USE MODD_REPROD_OPER, ONLY: CCHARNOCK
[5099]	97
[5144]	98	!USE MODE_THERMOS
	99	!USE MODI_WIND_THRESHOLD
	100	!USE MODI_SURFACE_RI
[5099]	101
[5144]	102	!USE YOMHOOK, ONLY: LHOOK, DR_HOOK
	103	!USE PARKIND1, ONLY: JPRB
[5099]	104
[5144]	105	!USE MODI_ABOR1_SFX
[5099]	106
[5144]	107	IMPLICIT NONE
[5099]	108
[5144]	109	! 0.1. Declarations of arguments
[5099]	110
[5144]	111	REAL, DIMENSION(klon), INTENT(IN) :: PVMOD ! module of wind at atm level (m/s)
	112	REAL, DIMENSION(klon), INTENT(IN) :: PTA ! air temperature at atm level (K)
	113	REAL, DIMENSION(klon), INTENT(IN) :: PQA ! air spec. hum. at atm level (kg/kg)
	114	REAL, DIMENSION(klon), INTENT(IN) :: PQSAT ! sea surface spec. hum. (kg/kg)
	115	REAL, DIMENSION(klon), INTENT(IN) :: PPA ! air pressure at atm level (Pa)
	116	!REAL, DIMENSION(:), INTENT(IN) :: PRHOA ! air density at atm level (kg/m3)
	117	!REAL, DIMENSION(:), INTENT(IN) :: PEXNA ! Exner function at atm level
	118	REAL, DIMENSION(klon), INTENT(IN) :: PUREF ! atm level for wind (m)
	119	REAL, DIMENSION(klon), INTENT(IN) :: PZREF ! atm level for temp./hum. (m)
	120	REAL, DIMENSION(klon), INTENT(IN) :: PSSS ! Sea Surface Salinity (g/kg)
	121	REAL, DIMENSION(klon), INTENT(IN) :: PPS ! air pressure at sea surface (Pa)
	122	!REAL, DIMENSION(:), INTENT(IN) :: PEXNS ! Exner function at sea surface
	123	!REAL, DIMENSION(:), INTENT(IN) :: PPERTFLUX ! stochastic flux perturbation pattern
	124	! for correction
	125	!REAL, INTENT(IN) :: PICHCE !
	126	LOGICAL, INTENT(IN) :: OPRECIP !
	127	LOGICAL, INTENT(IN) :: OPWEBB !
	128	LOGICAL, INTENT(IN) :: OPERTFLUX
	129	REAL, DIMENSION(klon), INTENT(IN) :: PRAIN ! precipitation rate (kg/s/m2)
[5099]	130
[5144]	131	!INTEGER, INTENT(IN) :: KZ0
[5099]	132
[5144]	133	REAL, DIMENSION(klon), INTENT(INOUT) :: PSST ! Sea Surface Temperature (K)
	134	REAL, DIMENSION(klon), INTENT(INOUT) :: PZ0SEA ! roughness length over sea
	135	REAL, DIMENSION(klon), INTENT(OUT) :: PZ0HSEA ! heat roughness length over sea
[4661]	136
[5144]	137	! surface fluxes : latent heat, sensible heat, friction fluxes
	138	REAL, DIMENSION(klon), INTENT(OUT) :: PUSTAR ! friction velocity (m/s)
	139	REAL, DIMENSION(klon), INTENT(OUT) :: PSFTH ! heat flux (W/m2)
	140	REAL, DIMENSION(klon), INTENT(OUT) :: PSFTQ ! water flux (kg/m2/s)
[4661]	141
[5144]	142	! diagnostics
	143	REAL, DIMENSION(klon), INTENT(OUT) :: PCD ! transfer coef. for momentum
	144	REAL, DIMENSION(klon), INTENT(OUT) :: PCH ! transfer coef. for temperature
	145	REAL, DIMENSION(klon), INTENT(OUT) :: PCE ! transfer coef. for humidity
	146	REAL, DIMENSION(klon), INTENT(OUT) :: PCDN ! neutral coef. for momentum
	147	REAL, DIMENSION(klon), INTENT(OUT) :: PRI ! Richardson number
	148	REAL, DIMENSION(klon), INTENT(OUT) :: PRESA ! aerodynamical resistance
	149	REAL, DIMENSION(3), INTENT(OUT) :: coeffs
[4661]	150
[5144]	151	! 0.2. Declarations of local variables
[5099]	152
[5144]	153	! specif SB
	154	INTEGER, DIMENSION(SIZE(PTA)) :: JCV ! convergence index
	155	INTEGER, DIMENSION(SIZE(PTA)) :: JITER ! nb of iterations to converge
	156	!rajout
	157	REAL, DIMENSION(SIZE(PTA)) :: PEXNA ! Exner function at atm level
	158	REAL, DIMENSION(SIZE(PTA)) :: PEXNS ! Exner function at atm level
[5099]	159
[5144]	160	REAL, DIMENSION(SIZE(PTA)) :: ZTAU ! momentum flux (N/m2)
	161	REAL, DIMENSION(SIZE(PTA)) :: ZHF ! sensible heat flux (W/m2)
	162	REAL, DIMENSION(SIZE(PTA)) :: ZEF ! latent heat flux (W/m2)
	163	REAL, DIMENSION(SIZE(PTA)) :: ZTAUR ! momentum flx due to rain (N/m2)
	164	REAL, DIMENSION(SIZE(PTA)) :: ZRF ! sensible flx due to rain (W/m2)
	165	REAL, DIMENSION(SIZE(PTA)) :: ZEFWEBB ! Webb corr. on latent flx (W/m2)
[4661]	166
[5144]	167	REAL, DIMENSION(SIZE(PTA)) :: ZVMOD ! wind intensity at atm level (m/s)
	168	REAL, DIMENSION(SIZE(PTA)) :: ZQSATA ! sat.spec.hum. at atm level (kg/kg)
	169	REAL, DIMENSION(SIZE(PTA)) :: ZLVA ! vap.heat of pure water at atm level (J/kg)
	170	REAL, DIMENSION(SIZE(PTA)) :: ZLVS ! vap.heat of seawater at sea surface (J/kg)
	171	REAL, DIMENSION(SIZE(PTA)) :: ZCPA ! specif.heat moist air (J/kg/K)
	172	REAL, DIMENSION(SIZE(PTA)) :: ZVISA ! kinemat.visc. of dry air (m2/s)
	173	REAL, DIMENSION(SIZE(PTA)) :: ZDU ! U vert.grad. (real atm)
	174	REAL, DIMENSION(SIZE(PTA)) :: ZDT, ZDQ ! T,Q vert.grad. (real atm)
	175	REAL, DIMENSION(SIZE(PTA)) :: ZDDU ! U vert.grad. (real atm + gust)
	176	REAL, DIMENSION(SIZE(PTA)) :: ZDDT, ZDDQ ! T,Q vert.grad. (real atm + WL/CS)
	177	REAL, DIMENSION(SIZE(PTA)) :: ZUSR ! velocity scaling param. (m/s)
	178	! =friction velocity
	179	REAL, DIMENSION(SIZE(PTA)) :: ZTSR ! temperature scaling param. (K)
	180	REAL, DIMENSION(SIZE(PTA)) :: ZQSR ! humidity scaling param. (kg/kg)
	181	REAL, DIMENSION(SIZE(PTA)) :: ZDELTAU10N, ZDELTAT10N, ZDELTAQ10N
	182	! U,T,Q vert.grad. (10m, neutral atm)
	183	REAL, DIMENSION(SIZE(PTA)) :: ZUSR0, ZTSR0, ZQSR0 ! ITERATIVE PROCESS
	184	REAL, DIMENSION(SIZE(PTA)) :: ZDUSTO, ZDTSTO, ZDQSTO ! ITERATIVE PROCESS
	185	REAL, DIMENSION(SIZE(PTA)) :: ZPSIU, ZPSIT! PSI funct for U, T/Q (Z0 comp)
	186	REAL, DIMENSION(SIZE(PTA)) :: ZCHARN ! Charnock parameter (Z0 comp)
[4661]	187
[5144]	188	REAL, DIMENSION(SIZE(PTA)) :: ZUSTAR2 ! square of friction velocity
	189	REAL, DIMENSION(SIZE(PTA)) :: ZAC ! aerodynamical conductance
	190	REAL, DIMENSION(SIZE(PTA)) :: ZDIRCOSZW ! orography slope cosine
	191	! (=1 on water!)
	192	REAL, DIMENSION(SIZE(PTA)) :: ZPARUN, ZPARTN, ZPARQN ! neutral parameter for U,T,Q
[4661]	193
[5144]	194	!-- rajout pour la pression saturante
	195	REAL, DIMENSION(SIZE(PPA)) :: ZFOES ! [OPWEBB]
	196	REAL, DIMENSION(SIZE(PPA)) :: ZWORK1
	197	REAL, DIMENSION(SIZE(PPA)) :: ZWORK2
	198	REAL, DIMENSION(SIZE(PPS)) :: ZWORK1A
	199	REAL, DIMENSION(SIZE(PPS)) :: ZWORK2A
	200	!#####################
[4661]	201
[5144]	202	REAL, DIMENSION(0:5) :: ZCOEFU, ZCOEFT, ZCOEFQ
[4661]	203
[5144]	204	!--------- Modif Olive -----------------
	205	REAL, DIMENSION(SIZE(PTA)) :: PRHOA
	206	REAL, PARAMETER :: XUNDEF = 1.E+20
[4661]	207
[5144]	208	REAL :: XVCHRNK = 0.021
	209	REAL :: XVZ0CM = 1.0E-5
	210	!REAL :: XRIMAX
[4661]	211
[5144]	212	CHARACTER :: CCHARNOCK = 'NEW'
[4661]	213
	214
[5144]	215	!--------------------------------------
[4661]	216
	217
[5144]	218	! local constants
	219	LOGICAL :: OPCVFLX ! to force convergence
	220	INTEGER :: NITERMAX ! nb of iterations to get free convergence
	221	INTEGER :: NITERSUP ! nb of additional iterations if OPCVFLX=.TRUE.
	222	INTEGER :: NITERFL ! maximum number of iterations
	223	REAL :: ZETV, ZRDSRV ! thermodynamic constants
	224	REAL :: ZSQR3
	225	REAL :: ZLMOMIN, ZLMOMAX ! min/max value of Obukhovs stability param. z/l
	226	REAL :: ZBTA, ZGMA ! parameters of the stability functions
	227	REAL :: ZDUSR0, ZDTSR0, ZDQSR0 ! maximum gap for USR/TSR/QSR between 2 steps
	228	REAL :: ZP00 ! [OPRECIP] - water vap. diffusiv.ref.press.(Pa)
	229	REAL :: ZUTU, ZUTT, ZUTQ ! U10n threshold in ECUME parameterisation
	230	REAL :: ZCDIRU, ZCDIRT, ZCDIRQ ! coef directeur pour fonction affine U,T,Q
	231	REAL :: ZORDOU, ZORDOT, ZORDOQ ! ordonnee a l'origine pour fonction affine U,T,Q
[4661]	232
[5144]	233	INTEGER :: JJ ! for ITERATIVE PROCESS
	234	INTEGER :: JLON, JK
	235	REAL :: ZLMOU, ZLMOT ! Obukhovs param. z/l for U, T/Q
	236	REAL :: ZPSI_U, ZPSI_T ! PSI funct. for U, T/Q
	237	REAL :: Z0TSEA, Z0QSEA ! roughness length for T, Q
	238	REAL :: ZCHIC, ZCHIK, ZPSIC, ZPSIK, ZLOGUS10, ZLOGTS10
	239	REAL :: ZTAC, ZCPWA, ZDQSDT, ZDWAT, ZDTMP, ZBULB ! [OPRECIP]
	240	REAL :: ZWW ! [OPWEBB]
[4661]	241
[5144]	242	INTEGER :: PREF ! reference pressure for exner function
	243	REAL, DIMENSION(klon) :: PQSATA ! sea surface spec. hum. (kg/kg)
[4661]	244
[5144]	245	REAL :: qsat_seawater2, qsat_seawater
[4661]	246
[5144]	247	!REAL(KIND=JPRB) :: ZHOOK_HANDLE
[4661]	248
[5144]	249	!-------------------------------------------------------------------------------
	250	!----------------------- Modif Olive calcul de PRHOA ---------------------------
[4661]	251
[5144]	252	!WRITE(,) "PZ0SEA ",PZ0SEA
	253	!WRITE(,) "PTA ",PTA
	254	!WRITE(,) "PSST ",PSST
	255	!WRITE(,) "PQA ",PQA
	256	!WRITE(,) "PVMOD ",PVMOD
	257	!WRITE(,) "PZREF ",PZREF
	258	!WRITE(,) "PUREF ",PUREF
	259	!WRITE(,) "PPS ",PPS
	260	!WRITE(,) "PPA ",PPA
	261	!WRITE(,) "OPRECIP ",OPRECIP
	262	!WRITE(,) "PZ0HSEA ",PZ0HSEA
	263	!WRITE(,) "PRAIN ",PRAIN
[4661]	264
[5144]	265	PRHOA(:) = PPS(:) / (287.1 * PTA(:) * (1. + .61 * PQA(:)))
	266	!WRITE(,) "klon klon ",klon,PTA
	267	!WRITE(,) "PRHOA ",SIZE(PRHOA),PRHOA
[5099]	268
[5144]	269	PREF = 100900. ! = 1000 hPa
[4661]	270
[5144]	271	!PEXNA = (PPA/PPS)**RKAPPA
	272	!PEXNS = (PPS/PPS)**RKAPPA
[4661]	273
[5144]	274	PEXNA = (PPA / PREF)**(RD / RCPD)
	275	PEXNS = (PPS / PREF)**(RD / RCPD)
[4661]	276
[5144]	277	!IF (LHOOK) CALL DR_HOOK('ECUMEV6_FLUX',0,ZHOOK_HANDLE)
[4661]	278
[5144]	279	ZDUSR0 = 1.E-06
	280	ZDTSR0 = 1.E-06
	281	ZDQSR0 = 1.E-09
[4661]	282
[5144]	283	NITERMAX = 5
	284	NITERSUP = 5
	285	OPCVFLX = .TRUE.
[4661]	286
[5144]	287	NITERFL = NITERMAX
	288	IF (OPCVFLX) NITERFL = NITERMAX + NITERSUP
[4661]	289
[5144]	290	ZCOEFU = (/ 1.00E-03, 3.66E-02, -1.92E-03, 2.32E-04, -7.02E-06, 6.40E-08 /)
	291	ZCOEFT = (/ 5.36E-03, 2.90E-02, -1.24E-03, 4.50E-04, -2.06E-05, 0.0 /)
	292	ZCOEFQ = (/ 1.00E-03, 3.59E-02, -2.87E-04, 0.0, 0.0, 0.0 /)
[5099]	293
[5144]	294	ZUTU = 40.0
	295	ZUTT = 14.4
	296	ZUTQ = 10.0
[5099]	297
[5144]	298	ZCDIRU = ZCOEFU(1) + 2.0 * ZCOEFU(2) * ZUTU + 3.0 * ZCOEFU(3) * ZUTU**2 &
	299	+ 4.0 * ZCOEFU(4) * ZUTU*3 + 5.0 ZCOEFU(5) * ZUTU**4
	300	ZCDIRT = ZCOEFT(1) + 2.0 * ZCOEFT(2) * ZUTT + 3.0 * ZCOEFT(3) * ZUTT**2 &
	301	+ 4.0 * ZCOEFT(4) * ZUTT**3
	302	ZCDIRQ = ZCOEFQ(1) + 2.0 * ZCOEFQ(2) * ZUTQ
[5099]	303
[5144]	304	ZORDOU = ZCOEFU(0) + ZCOEFU(1) * ZUTU + ZCOEFU(2) * ZUTU*2 + ZCOEFU(3) ZUTU**3 &
	305	+ ZCOEFU(4) * ZUTU*4 + ZCOEFU(5) ZUTU**5
	306	ZORDOT = ZCOEFT(0) + ZCOEFT(1) * ZUTT + ZCOEFT(2) * ZUTT*2 + ZCOEFT(3) ZUTT**3 &
	307	+ ZCOEFT(4) * ZUTT**4
	308	ZORDOQ = ZCOEFQ(0) + ZCOEFQ(1) * ZUTQ + ZCOEFQ(2) * ZUTQ**2
[5099]	309
[5144]	310	!-------------------------------------------------------------------------------
[5099]	311
[5144]	312	! 1. AUXILIARY CONSTANTS & ARRAY INITIALISATION BY UNDEFINED VALUES.
	313	! --------------------------------------------------------------------
[5099]	314
[5144]	315	ZDIRCOSZW(:) = 1.0
[5099]	316
[5144]	317	ZETV = XRV / XRD - 1.0 !~0.61 (cf Liu et al. 1979)
	318	ZRDSRV = XRD / XRV !~0.622
	319	ZSQR3 = SQRT(3.0)
	320	ZLMOMIN = -200.0
	321	ZLMOMAX = 0.25
	322	ZBTA = 16.0
	323	ZGMA = 7.0 !initially =4.7, modified to 7.0 following G. Caniaux
[5099]	324
[5144]	325	ZP00 = 1013.25E+02
[5099]	326
[5144]	327	PCD = XUNDEF
	328	PCH = XUNDEF
	329	PCE = XUNDEF
	330	PCDN = XUNDEF
	331	ZUSR = XUNDEF
	332	ZTSR = XUNDEF
	333	ZQSR = XUNDEF
	334	ZTAU = XUNDEF
	335	ZHF = XUNDEF
	336	ZEF = XUNDEF
[5099]	337
[5144]	338	PSFTH = XUNDEF
	339	PSFTQ = XUNDEF
	340	PUSTAR = XUNDEF
	341	PRESA = XUNDEF
	342	PRI = XUNDEF
[5099]	343
[5144]	344	ZTAUR = 0.0
	345	ZRF = 0.0
	346	ZEFWEBB = 0.0
[5099]	347
[5144]	348	!-------------------------------------------------------------------------------
[5099]	349
[5144]	350	! 2. INITIALISATIONS BEFORE ITERATIVE LOOP.
	351	! -------------------------------------------
[5099]	352
[5144]	353	!ZVMOD(:) = WIND_THRESHOLD(PVMOD(:),PUREF(:)) !set a minimum value to wind
	354	ZVMOD = MAX(PVMOD, 0.1 * MIN(10., PUREF)) !set a minimum value to wind
[5099]	355
[5144]	356	WRITE(, ) "ZVMOD ", SIZE(ZVMOD)
[5099]	357
[5144]	358	! 2.0. Radiative fluxes - For warm layer & cool skin
[5099]	359
[5144]	360	! 2.0b. Warm Layer correction
[5099]	361
[5144]	362	! 2.1. Specific humidity at saturation
[4661]	363
[5144]	364	WHERE(PSSS(:)>0.0.AND.PSSS(:)/=XUNDEF)
	365	PQSATA = QSAT_SEAWATER2 (PSST(:), PPS(:), PSSS(:)) !at sea surface
	366	ELSEWHERE
	367	PQSATA (:) = QSAT_SEAWATER (PSST(:), PPS(:)) !at sea surface
	368	ENDWHERE
[4661]	369
[5144]	370	!ZQSATA(:) = QSAT(PTA(:),PPA(:)) !at atm level
[5099]	371
[5144]	372	!### OLIVIER POUR PRESSION SATURANTE #####
	373	!-------------------------------------------------------------------------------
[5099]	374
[5144]	375	ZFOES = 1 !PSAT(PT(:))
	376	ZFOES = 0.98 * ZFOES
[5099]	377
[5144]	378	ZWORK1 = ZFOES / PPS
	379	ZWORK2 = XRD / XRV
[4661]	380
[5144]	381	ZWORK1A = ZFOES / PPA
	382	ZWORK2A = XRD / XRV
[4661]	383
[5144]	384	!WRITE(,) "ZFOES ",ZFOES
	385	!WRITE(,) "PPS ",PPS
	386	!WRITE(,) "ZWORK1 ",ZWORK1
	387	!WRITE(,) "XRD ",XRD
	388	!WRITE(,) "XRV ",XRV
	389	!WRITE(,) "PPA ",PPA
	390	!WRITE(,) "ZWORK1A ",ZWORK1A
[5099]	391
[5144]	392	WRITE(, ) "PQSAT : ", PQSAT
	393	WRITE(, ) "PQSATA : ", PQSATA
[5099]	394
[5144]	395	!* 2. COMPUTE SATURATION HUMIDITY
	396	! ---------------------------
[4661]	397
[5144]	398	!PQSAT = ZWORK2ZWORK1 / (1.+(ZWORK2-1.)ZWORK1)
	399	!ZQSATA = ZWORK2AZWORK1A / (1.+(ZWORK2A-1.)ZWORK1A)
	400	ZQSATA = QSAT_SEAWATER (PTA(:), PPA(:)) !at sea surface
[4661]	401
[5144]	402	! 2.2. Gradients at the air-sea interface
[4661]	403
[5144]	404	ZDU(:) = ZVMOD(:) !one assumes u is measured / sea surface current
	405	ZDT(:) = PTA(:) / PEXNA(:) - PSST(:) / PEXNS(:)
	406	ZDQ(:) = PQA(:) - PQSATA(:)
[4661]	407
[5144]	408	WRITE(, ) "PQA ", PQA(:)
	409	WRITE(, ) "PQSAT", PQSAT(:)
	410	WRITE(, ) "ZDQ", ZDQ(:)
[5099]	411
[5144]	412	! 2.3. Latent heat of vaporisation
[4661]	413
[5144]	414	ZLVA(:) = XLVTT + (XCPV - XCL) * (PTA (:) - XTT) !of pure water at atm level
	415	ZLVS(:) = XLVTT + (XCPV - XCL) * (PSST(:) - XTT) !of pure water at sea surface
[4661]	416
[5144]	417	WRITE(, ) "ZLVA ", ZLVA
	418	WRITE(, ) "ZLVS ", ZLVS
[4661]	419
[5144]	420	WHERE(PSSS(:)>0.0.AND.PSSS(:)/=XUNDEF)
	421	ZLVS(:) = ZLVS(:) * (1.0 - 1.00472E-3 * PSSS(:)) !of seawater at sea surface
	422	ENDWHERE
[5099]	423
[5144]	424	! 2.4. Specific heat of moist air (Businger 1982)
[5099]	425
[5144]	426	!ZCPA(:) = XCPD(1.0+(XCPV/XCPD-1.0)PQA(:))
	427	ZCPA(:) = XCPD
[4661]	428
[5144]	429	! 2.4b Kinematic viscosity of dry air (Andreas 1989, CRREL Rep. 89-11)
[4661]	430
[5144]	431	ZVISA(:) = 1.326E-05 * (1.0 + 6.542E-03 * (PTA(:) - XTT) + 8.301E-06 * (PTA(:) - XTT)**2 &
	432	- 4.84E-09 * (PTA(:) - XTT)**3)
[4661]	433
[5144]	434	! 2.4c Coefficients for warm layer and/or cool skin correction
[4661]	435
[5144]	436	! 2.5. Initial guess
[4661]	437
[5144]	438	ZDDU(:) = ZDU(:)
	439	ZDDT(:) = ZDT(:)
	440	ZDDQ(:) = ZDQ(:)
	441	ZDDU(:) = SIGN(MAX(ABS(ZDDU(:)), 10.0 * ZDUSR0), ZDDU(:))
	442	ZDDT(:) = SIGN(MAX(ABS(ZDDT(:)), 10.0 * ZDTSR0), ZDDT(:))
	443	ZDDQ(:) = SIGN(MAX(ABS(ZDDQ(:)), 10.0 * ZDQSR0), ZDDQ(:))
[5099]	444
[5144]	445	WRITE(, ) "ZDDU ", ZDDU
	446	WRITE(, ) "ZDDQ ", ZDDQ
	447	WRITE(, ) "ZDDT ", ZDDT
[5099]	448
[5144]	449	JCV (:) = -1
	450	ZUSR(:) = 0.04 * ZDDU(:)
	451	ZTSR(:) = 0.04 * ZDDT(:)
	452	ZQSR(:) = 0.04 * ZDDQ(:)
	453	ZDELTAU10N(:) = ZDDU(:)
	454	ZDELTAT10N(:) = ZDDT(:)
	455	ZDELTAQ10N(:) = ZDDQ(:)
	456	JITER(:) = 99
[5099]	457
[5144]	458	! In the following, we suppose that Richardson number PRI < XRIMAX
	459	! If not true, Monin-Obukhov theory can't (and therefore shouldn't) be applied !
	460	!-------------------------------------------------------------------------------
[5099]	461
[5144]	462	! 3. ITERATIVE LOOP TO COMPUTE U, T, Q*.
	463	! ------------------------------------------
[5099]	464
[5144]	465	DO JJ = 1, NITERFL
	466	DO JLON = 1, SIZE(PTA)
[5099]	467
[5144]	468	IF (JCV(JLON) == -1) THEN
	469	ZUSR0(JLON) = ZUSR(JLON)
	470	ZTSR0(JLON) = ZTSR(JLON)
	471	ZQSR0(JLON) = ZQSR(JLON)
	472	IF (JJ == NITERMAX + 1 .OR. JJ == NITERMAX + NITERSUP) THEN
	473	ZDELTAU10N(JLON) = 0.5 * (ZDUSTO(JLON) + ZDELTAU10N(JLON)) !forced convergence
	474	ZDELTAT10N(JLON) = 0.5 * (ZDTSTO(JLON) + ZDELTAT10N(JLON))
	475	ZDELTAQ10N(JLON) = 0.5 * (ZDQSTO(JLON) + ZDELTAQ10N(JLON))
	476	IF (JJ == NITERMAX + NITERSUP) JCV(JLON) = 3
	477	ENDIF
	478	ZDUSTO(JLON) = ZDELTAU10N(JLON)
	479	ZDTSTO(JLON) = ZDELTAT10N(JLON)
	480	ZDQSTO(JLON) = ZDELTAQ10N(JLON)
[5099]	481
[5144]	482	! 3.1. Neutral parameter for wind speed (ECUME_V6 formulation)
[4661]	483
[5144]	484	IF (ZDELTAU10N(JLON) <= ZUTU) THEN
	485	ZPARUN(JLON) = ZCOEFU(0) + ZCOEFU(1) * ZDELTAU10N(JLON) &
	486	+ ZCOEFU(2) * ZDELTAU10N(JLON)**2 &
	487	+ ZCOEFU(3) * ZDELTAU10N(JLON)**3 &
	488	+ ZCOEFU(4) * ZDELTAU10N(JLON)**4 &
	489	+ ZCOEFU(5) * ZDELTAU10N(JLON)**5
	490	ELSE
	491	ZPARUN(JLON) = ZCDIRU * (ZDELTAU10N(JLON) - ZUTU) + ZORDOU
	492	ENDIF
	493	PCDN(JLON) = (ZPARUN(JLON) / ZDELTAU10N(JLON))**2
[4661]	494
[5144]	495	! 3.2. Neutral parameter for temperature (ECUME_V6 formulation)
[5099]	496
[5144]	497	IF (ZDELTAU10N(JLON) <= ZUTT) THEN
	498	ZPARTN(JLON) = ZCOEFT(0) + ZCOEFT(1) * ZDELTAU10N(JLON) &
	499	+ ZCOEFT(2) * ZDELTAU10N(JLON)**2 &
	500	+ ZCOEFT(3) * ZDELTAU10N(JLON)**3 &
	501	+ ZCOEFT(4) * ZDELTAU10N(JLON)**4
	502	ELSE
	503	ZPARTN(JLON) = ZCDIRT * (ZDELTAU10N(JLON) - ZUTT) + ZORDOT
	504	ENDIF
[5099]	505
[5144]	506	! 3.3. Neutral parameter for humidity (ECUME_V6 formulation)
[5099]	507
[5144]	508	IF (ZDELTAU10N(JLON) <= ZUTQ) THEN
	509	ZPARQN(JLON) = ZCOEFQ(0) + ZCOEFQ(1) * ZDELTAU10N(JLON) &
	510	+ ZCOEFQ(2) * ZDELTAU10N(JLON)**2
	511	ELSE
	512	ZPARQN(JLON) = ZCDIRQ * (ZDELTAU10N(JLON) - ZUTQ) + ZORDOQ
	513	ENDIF
[5099]	514
[5144]	515	! 3.4. Scaling parameters U, T, Q*
[5099]	516
[5144]	517	ZUSR(JLON) = ZPARUN(JLON)
	518	ZTSR(JLON) = ZPARTN(JLON) * ZDELTAT10N(JLON) / ZDELTAU10N(JLON)
	519	ZQSR(JLON) = ZPARQN(JLON) * ZDELTAQ10N(JLON) / ZDELTAU10N(JLON)
[5099]	520
[5144]	521	! 3.4b Gustiness factor (Deardorff 1970)
[5099]	522
[5144]	523	! 3.4c Cool skin correction
[5099]	524
[5144]	525	! 3.5. Obukhovs stability param. z/l following Liu et al. (JAS, 1979)
[5099]	526
[5144]	527	! For U
	528	ZLMOU = PUREF(JLON) * XG * XKARMAN * (ZTSR(JLON) / PTA(JLON) &
	529	+ ZETV * ZQSR(JLON) / (1.0 + ZETV * PQA(JLON))) / ZUSR(JLON)**2
	530	! For T/Q
	531	ZLMOT = ZLMOU * (PZREF(JLON) / PUREF(JLON))
	532	ZLMOU = MAX(MIN(ZLMOU, ZLMOMAX), ZLMOMIN)
	533	ZLMOT = MAX(MIN(ZLMOT, ZLMOMAX), ZLMOMIN)
[5099]	534
[5144]	535	! 3.6. Stability function psi (see Liu et al, 1979 ; Dyer and Hicks, 1970)
	536	! Modified to include convective form following Fairall (unpublished)
[5099]	537
[5144]	538	! For U
	539	IF (ZLMOU == 0.0) THEN
	540	ZPSI_U = 0.0
	541	ELSEIF (ZLMOU > 0.0) THEN
	542	ZPSI_U = -ZGMA * ZLMOU
	543	ELSE
	544	ZCHIK = (1.0 - ZBTA * ZLMOU)**0.25
	545	ZPSIK = 2.0 * LOG((1.0 + ZCHIK) / 2.0) &
	546	+ LOG((1.0 + ZCHIK**2) / 2.0) &
	547	- 2.0 * ATAN(ZCHIK) + 0.5 * XPI
	548	ZCHIC = (1.0 - 12.87 * ZLMOU)**(1.0 / 3.0) !for very unstable conditions
	549	ZPSIC = 1.5 * LOG((ZCHIC**2 + ZCHIC + 1.0) / 3.0) &
	550	- ZSQR3 * ATAN((2.0 * ZCHIC + 1.0) / ZSQR3) &
	551	+ XPI / ZSQR3
	552	ZPSI_U = ZPSIC + (ZPSIK - ZPSIC) / (1.0 + ZLMOU**2) !match Kansas & free-conv. forms
	553	ENDIF
	554	ZPSIU(JLON) = ZPSI_U
	555	! For T/Q
	556	IF (ZLMOT == 0.0) THEN
	557	ZPSI_T = 0.0
	558	ELSEIF (ZLMOT > 0.0) THEN
	559	ZPSI_T = -ZGMA * ZLMOT
	560	ELSE
	561	ZCHIK = (1.0 - ZBTA * ZLMOT)**0.25
	562	ZPSIK = 2.0 * LOG((1.0 + ZCHIK**2) / 2.0)
	563	ZCHIC = (1.0 - 12.87 * ZLMOT)**(1.0 / 3.0) !for very unstable conditions
	564	ZPSIC = 1.5 * LOG((ZCHIC**2 + ZCHIC + 1.0) / 3.0) &
	565	- ZSQR3 * ATAN((2.0 * ZCHIC + 1.0) / ZSQR3) &
	566	+ XPI / ZSQR3
	567	ZPSI_T = ZPSIC + (ZPSIK - ZPSIC) / (1.0 + ZLMOT**2) !match Kansas & free-conv. forms
	568	ENDIF
	569	ZPSIT(JLON) = ZPSI_T
[5099]	570
[5144]	571	! 3.7. Update air-sea gradients
[5099]	572
[5144]	573	ZDDU(JLON) = ZDU(JLON)
	574	ZDDT(JLON) = ZDT(JLON)
	575	ZDDQ(JLON) = ZDQ(JLON)
	576	ZDDU(JLON) = SIGN(MAX(ABS(ZDDU(JLON)), 10.0 * ZDUSR0), ZDDU(JLON))
	577	ZDDT(JLON) = SIGN(MAX(ABS(ZDDT(JLON)), 10.0 * ZDTSR0), ZDDT(JLON))
	578	ZDDQ(JLON) = SIGN(MAX(ABS(ZDDQ(JLON)), 10.0 * ZDQSR0), ZDDQ(JLON))
	579	ZLOGUS10 = LOG(PUREF(JLON) / 10.0)
	580	ZLOGTS10 = LOG(PZREF(JLON) / 10.0)
	581	ZDELTAU10N(JLON) = ZDDU(JLON) - ZUSR(JLON) * (ZLOGUS10 - ZPSI_U) / XKARMAN
	582	ZDELTAT10N(JLON) = ZDDT(JLON) - ZTSR(JLON) * (ZLOGTS10 - ZPSI_T) / XKARMAN
	583	ZDELTAQ10N(JLON) = ZDDQ(JLON) - ZQSR(JLON) * (ZLOGTS10 - ZPSI_T) / XKARMAN
	584	ZDELTAU10N(JLON) = SIGN(MAX(ABS(ZDELTAU10N(JLON)), 10.0 * ZDUSR0), &
	585	ZDELTAU10N(JLON))
	586	ZDELTAT10N(JLON) = SIGN(MAX(ABS(ZDELTAT10N(JLON)), 10.0 * ZDTSR0), &
	587	ZDELTAT10N(JLON))
	588	ZDELTAQ10N(JLON) = SIGN(MAX(ABS(ZDELTAQ10N(JLON)), 10.0 * ZDQSR0), &
	589	ZDELTAQ10N(JLON))
[5099]	590
[5144]	591	! 3.8. Test convergence for U, T, Q*
[5099]	592
[5144]	593	IF (ABS(ZUSR(JLON) - ZUSR0(JLON)) < ZDUSR0 .AND. &
	594	ABS(ZTSR(JLON) - ZTSR0(JLON)) < ZDTSR0 .AND. &
	595	ABS(ZQSR(JLON) - ZQSR0(JLON)) < ZDQSR0) THEN
	596	JCV(JLON) = 1 !free convergence
	597	IF (JJ >= NITERMAX + 1) JCV(JLON) = 2 !leaded convergence
	598	ENDIF
	599	JITER(JLON) = JJ
	600	ENDIF
[5099]	601
[5144]	602	ENDDO
[4661]	603	ENDDO
[5099]	604
[5144]	605	!-------------------------------------------------------------------------------
[5099]	606
[5144]	607	! 4. COMPUTATION OF TURBULENT FLUXES AND EXCHANGE COEFFICIENTS.
	608	! ---------------------------------------------------------------
[5099]	609
[5144]	610	DO JLON = 1, SIZE(PTA)
[5099]	611
[5144]	612	! 4.1. Surface turbulent fluxes
	613	! (ATM CONV.: ZTAU<<0 ; ZHF,ZEF<0 if atm looses heat)
[5099]	614
[5144]	615	ZTAU(JLON) = -PRHOA(JLON) * ZUSR(JLON)**2
	616	ZHF(JLON) = -PRHOA(JLON) * ZCPA(JLON) * ZUSR(JLON) * ZTSR(JLON)
	617	ZEF(JLON) = -PRHOA(JLON) * ZLVS(JLON) * ZUSR(JLON) * ZQSR(JLON)
[4661]	618
[5144]	619	WRITE(, ) "ZTAU = ", ZTAU(JLON)
	620	WRITE(, ) "SENS = ", ZHF(JLON)
	621	WRITE(, ) "LAT = ", ZEF(JLON)
[4661]	622
[5144]	623	! 4.2. Exchange coefficients PCD, PCH, PCE
[5099]	624
[5144]	625	PCD(JLON) = (ZUSR(JLON) / ZDDU(JLON))**2
	626	PCH(JLON) = (ZUSR(JLON) * ZTSR(JLON)) / (ZDDU(JLON) * ZDDT(JLON))
	627	PCE(JLON) = (ZUSR(JLON) * ZQSR(JLON)) / (ZDDU(JLON) * ZDDQ(JLON))
[4661]	628
[5144]	629	WRITE(, ) "ZUSR = ", ZUSR(JLON)
	630	WRITE(, ) "ZTSR = ", ZTSR(JLON)
	631	WRITE(, ) "ZQSR = ", ZQSR(JLON)
[4661]	632
[5144]	633	! 4.3. Stochastic perturbation of turbulent fluxes
[5099]	634
[5144]	635	! IF( OPERTFLUX )THEN
	636	! ZTAU(JLON) = ZTAU(JLON)* ( 1. + PPERTFLUX(JLON) / 2. )
	637	! ZHF (JLON) = ZHF(JLON)* ( 1. + PPERTFLUX(JLON) / 2. )
	638	! ZEF (JLON) = ZEF(JLON)* ( 1. + PPERTFLUX(JLON) / 2. )
	639	! ENDIF
[5099]	640
[5144]	641	ENDDO
[5099]	642
[5144]	643	!-------------------------------------------------------------------------------
[5099]	644
[5144]	645	! 5. COMPUTATION OF FLUX CORRECTIONS DUE TO RAINFALL.
	646	! (ATM conv: ZRF<0 if atm. looses heat, ZTAUR<<0)
	647	! -----------------------------------------------------
[5099]	648
[5144]	649	IF (OPRECIP) THEN
	650	DO JLON = 1, SIZE(PTA)
[5099]	651
[5144]	652	! 5.1. Momentum flux due to rainfall (ZTAUR, N/m2)
[5099]	653
[5144]	654	! See pp3752 in FBR96.
	655	ZTAUR(JLON) = -0.85 * PRAIN(JLON) * PVMOD(JLON)
[5099]	656
[5144]	657	! 5.2. Sensible heat flux due to rainfall (ZRF, W/m2)
[5099]	658
[5144]	659	! See Eq.12 in GoF95 with ZCPWA as specific heat of water at atm level (J/kg/K),
	660	! ZDQSDT from Clausius-Clapeyron relation, ZDWAT as water vapor diffusivity
	661	! (Eq.13-3 of Pruppacher and Klett, 1978), ZDTMP as heat diffusivity, and ZBULB
	662	! as wet-bulb factor (Eq.11 in GoF95).
[5099]	663
[5144]	664	ZTAC = PTA(JLON) - XTT
	665	ZCPWA = 4217.51 - 3.65566 * ZTAC + 0.1381 * ZTAC**2 &
	666	- 2.8309E-03 * ZTAC*3 + 3.42061E-05 ZTAC**4 &
	667	- 2.18107E-07 * ZTAC*5 + 5.74535E-10 ZTAC**6
	668	ZDQSDT = (ZLVA(JLON) * ZQSATA(JLON)) / (XRV * PTA(JLON)**2)
	669	ZDWAT = 2.11E-05 * (ZP00 / PPA(JLON)) * (PTA(JLON) / XTT)**1.94
	670	ZDTMP = (1.0 + 3.309E-03 * ZTAC - 1.44E-06 * ZTAC**2) &
	671	* 0.02411 / (PRHOA(JLON) * ZCPA(JLON))
	672	ZBULB = 1.0 / (1.0 + ZDQSDT * (ZLVA(JLON) * ZDWAT) / (ZCPA(JLON) * ZDTMP))
	673	ZRF(JLON) = PRAIN(JLON) * ZCPWA * ZBULB * ((PSST(JLON) - PTA(JLON)) &
	674	+ (PQSATA(JLON) - PQA(JLON)) * (ZLVA(JLON) * ZDWAT) / (ZCPA(JLON) * ZDTMP))
[5099]	675
[5144]	676	ENDDO
	677	ENDIF
[5099]	678
[5144]	679	!-------------------------------------------------------------------------------
[5099]	680
[5144]	681	! 6. COMPUTATION OF WEBB CORRECTION TO LATENT HEAT FLUX (ZEFWEBB, W/m2).
	682	! ------------------------------------------------------------------------
[5099]	683
[5144]	684	! See Eq.21 and Eq.22 in FBR96.
	685	IF (OPWEBB) THEN
	686	DO JLON = 1, SIZE(PTA)
	687	ZWW = (1.0 + ZETV) * (ZUSR(JLON) * ZQSR(JLON)) &
	688	+ (1.0 + (1.0 + ZETV) * PQA(JLON)) * (ZUSR(JLON) * ZTSR(JLON)) / PTA(JLON)
	689	ZEFWEBB(JLON) = -PRHOA(JLON) * ZLVS(JLON) * ZWW * PQA(JLON)
	690	ENDDO
	691	ENDIF
[5099]	692
[5144]	693	!-------------------------------------------------------------------------------
[5099]	694
[5144]	695	! 7. FINAL STEP : TOTAL SURFACE FLUXES AND DERIVED DIAGNOSTICS.
	696	! ---------------------------------------------------------------
[5099]	697
[5144]	698	! 7.1. Richardson number
[5099]	699
[5144]	700	! CALL SURFACE_RI(PSST,PQSAT,PEXNS,PEXNA,PTA,PQA, &
	701	! PZREF,PUREF,ZDIRCOSZW,PVMOD,PRI)
[5099]	702
[5144]	703	! 7.2. Friction velocity which contains correction due to rain
[5099]	704
[5144]	705	ZUSTAR2(:) = -(ZTAU(:) + ZTAUR(:)) / PRHOA(:) !>>0 as ZTAU<<0 & ZTAUR<=0
[5099]	706
[5144]	707	IF (OPRECIP) THEN
	708	PCD(:) = ZUSTAR2(:) / ZDDU(:)**2
	709	ENDIF
[5099]	710
[5144]	711	PUSTAR(:) = SQRT(ZUSTAR2(:)) !>>0
[5099]	712
[5144]	713	! 7.3. Aerodynamical conductance and resistance
[5099]	714
[5144]	715	ZAC (:) = PCH(:) * ZDDU(:)
	716	PRESA(:) = 1.0 / ZAC(:)
[5099]	717
[5144]	718	! 7.4. Total surface fluxes
[5099]	719
[5144]	720	PSFTH(:) = ZHF(:) + ZRF(:)
	721	PSFTQ(:) = (ZEF(:) + ZEFWEBB(:)) / ZLVS(:)
[5099]	722
[5144]	723	! 7.5. Charnock number
[5099]	724
[5144]	725	IF (CCHARNOCK == 'OLD') THEN
	726	ZCHARN(:) = XVCHRNK
	727	ELSE !modified for moderate wind speed as in COARE3.0
	728	ZCHARN(:) = MIN(0.018, MAX(0.011, 0.011 + (0.007 / 8.0) * (ZDDU(:) - 10.0)))
	729	ENDIF
[5099]	730
[5144]	731	! 7.6. Roughness lengths Z0 and Z0H over sea
[5099]	732
[5144]	733	!IF (KZ0 == 0) THEN ! ARPEGE formulation
	734	! PZ0SEA (:) = (ZCHARN(:)/XG)ZUSTAR2(:) + XVZ0CMPCD(:)/PCDN(:)
	735	! PZ0HSEA(:) = PZ0SEA (:)
	736	!ELSEIF (KZ0 == 1) THEN ! Smith (1988) formulation
	737	! PZ0SEA (:) = (ZCHARN(:)/XG)ZUSTAR2(:) + 0.11ZVISA(:)/PUSTAR(:)
	738	! PZ0HSEA(:) = PZ0SEA (:)
	739	!ELSEIF (KZ0 == 2) THEN ! Direct computation using the stability functions
	740	! DO JLON=1,SIZE(PTA)
	741	! PZ0SEA (JLON) = PUREF(JLON)/EXP(XKARMAN*ZDDU(JLON)/PUSTAR(JLON)+ZPSIU(JLON))
	742	! Z0TSEA = PZREF(JLON)/EXP(XKARMAN*ZDDT(JLON)/ZTSR (JLON)+ZPSIT(JLON))
	743	! Z0QSEA = PZREF(JLON)/EXP(XKARMAN*ZDDQ(JLON)/ZQSR (JLON)+ZPSIT(JLON))
	744	! PZ0HSEA(JLON) = 0.5*(Z0TSEA+Z0QSEA)
	745	! ENDDO
	746	!ENDIF
[4661]	747
[5144]	748	WRITE(, ) "JLON ", JLON
	749	WRITE(, ) "PTA ", klon, PTA
	750	WRITE(, ) "PCD ", SIZE(PCD), PCD
	751	WRITE(, ) "PCQ ", SIZE(PCE), PCE
	752	WRITE(, ) "PCH ", SIZE(PCH), PCH
[4661]	753
[5144]	754	coeffs = [PCD, &
	755	PCE, &
	756	PCH]
[5099]	757
	758
[5144]	759	!IF (LHOOK) CALL DR_HOOK('ECUMEV6_FLUX',1,ZHOOK_HANDLE)
[5099]	760
[5144]	761	!-------------------------------------------------------------------------------
	762	END SUBROUTINE ECUMEV6_FLUX

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

Download in other formats:

Original Format