!copyright (C) 2001 MSC-RPN COMM %%%RPNPHY%%%
*** S/P PHYOPT
*
SUBROUTINE PHYOPTC (NOM,VALEURC,NV,MODE) 11
*
IMPLICIT NONE
*
CHARACTER *(*) NOM, MODE
CHARACTER MODEC*3,NOMC*16,TYPE*1
INTEGER I,NV
CHARACTER VALEURC(NV) *(*)
INTEGER VALEURI(NV)
LOGICAL VALEURL(NV)
REAL VALEURR(NV)
*
*Author
* B. Bilodeau (Spring 1994)
*
*Revisions
* 001 M. Gagnon (Jul 95) - Initialize radnivl
* 002 M. Desgagne (Nov 95) - Schmsol for CLASS
* 003 B. Dugas (Sep 96) - 1) Change GWDRAG switch to character
* 2) Add RADFIX logical option
* 3) Add ETRMIN,TAUFAC,Z0MIN real options
* 4) Add SHLCVT character switch
* 004 G. Pellerin (Oct 96) - Options KUOSTD,KUOSYM,KUOSUN added
* along with updated condensation CONSUN
* 005 G. Pellerin (Nov 96) - Options RAS and SHALODQC added
* 006 G. Pellerin (Apr 97) - Advection of liquid water switch
* 007 M. Desgagne (Apr 96) - ADVECTKE
* 008 F. Kong (Dec 96) - Explicit schemes in STCOND
* 009 B. Bilodeau (Aug 97) - Z0DIR
* 010 B. Bilodeau (Jun 98) - RADFILES
* 011 P.-A. Michelangeli (Jul 98) - Add FOMIC logical option
* 012 B. Bilodeau (Dec 99) - NSLOFLUX
* 013 N. Brunet (Sep 99) - add 5 logical options
* (cortm,corts,drylaps,montagn,bkgalb)
* (project to move treatment of geophysical
* fields into physical library)
* 014 B. Bilodeau (Apr 2000) - ICEMELT (sea ice melting)
* 015 B. Bilodeau (Mar 2001) - SNOALB_ANL
* 016 J. Mailhot (Nov 2000) - Add moist turbulence option (ifluvert=3)
* 017 A.-M. Leduc (Nov 2001) - Add KFC parameters
* 018 A. Erfani (Nov 2001) - Add KFCKUO2 option
* 019 B. Bilodeau (Feb 2002) - Add Z0TCST option
* 020 B. Bilodeau (Mar 2002) - Remove AIRE
* 021 S. Laroche (Mar 2002) - Add options for the linearized physics
* 022 A-M. Leduc , B. Bilodeau (Dec 2002) - Switch shlcvt with double options
* 023 A-M. Leduc (Dec 2002) - Add KFCPCP switch: conservation of pcpn in kfcp
* 024 B. Dugas (Sep 2002) - Add CO2 concentration parameter
* 025 B. Bilodeau (Feb 2003) - Add AS2, BETA2 and KKL2 parameters
* 026 B. Dugas (Mar 2003) - Add STRATOS parametre
* 027 JF Mahfouf (May 2003) - Add IMPFLX option for coupling surface with vert. diff.
* 028 A-M. Leduc (Jun 2003) - add RADFLTR switch
* 029 A. Plante (Sep 2003) - add PCPTYPE switch
* 030 B. Bilodeau (Mar 2004) - add TSCONFC and KFCTRIG4
*
*Object
* to initialize the physics comdeck OPTIONS
*
*Arguments
*
* - Input -
* NOM name of the option to be treated
*
* - Input/Output -
* VALEURC value of the character constant
* VALEURI value of the integer constant
* VALEURL value of the logical constant
* VALEURR value of the real constant
*
* - Input -
* NV number of values to be treated
* MODE mode of operation : SET = initialize the value
* GET = extract the value
*
*Notes
* phyopt sets or gets options of four
* types : character, integer, logical
* and real. It includes 3 entry points.
*
**
*
#include "options.cdk"
#include "dzsedi.cdk"
#include "phy_macros_f.h"
*
************************************************************************
* AUTOMATIC ARRAYS
************************************************************************
*
AUTOMATIC ( VALC , CHARACTER*8 , (NV) )
*
************************************************************************
*
* INITIALISATION DES CLEFS
*
DATA ICONVEC,IFLUVERT,IGWDRAG,ILONGMEL /4*1000/
DATA IRADIA,ISCHMSOL,ISHLCVT,ISTCOND /5*1000/
DATA IKFCPCP,IPCPTYPE /2*1000/
DATA CONVEC,FLUVERT,GWDRAG,LONGMEL,RADIA,SCHMSOL /6*' '/
DATA PCPTYPE /' '/
DATA SHLCVT,STCOND,KFCPCP /4*' '/
DATA RADFILES /'STD'/
DATA DATE,KNTRAD,MOYHR /16*0/
DATA NSLOFLUX /0/
DATA BKGALB,CHAUF,CORTM,DMOM,DRAG,DRYLAPS,EVAP,
+ MONTAGN,RADFIX,RADFLTR,SATUCO,SNOALB_ANL,WET,Z0TCST
+ /14*.TRUE. /
DATA ADVECTKE,AGREGAT,CLIMAT,CORTS,DBGMEM,DIFFUW,
+ FOMIC,ICEMELT,INILWC,SNOWMELT,STOMATE,
+ STRATOS,TSCONFC,TYPSOL,Z0DIR
+ /15*.FALSE./
DATA AS2,BETA2,KKL2 /12., 1.0, 0.1/
DATA DZSEDI, DZSEDI_DEF /2*350./
DATA FACDIFV, FACTDT /2*0.0/,
+ HC2, HF2, HM2 /0.6, 1.0, 1.0/,
+ PARSOL/6*0.0/, EPONGE /LEVMAX * 0.0 /
DATA ETRMIN2,QCO2,TAUFAC,Z0MIN2 / 1.E-4,360.,8.E-6,1.5E-5 /
DATA RADNIVL /LEVMAX * 0, 0/
DATA KFCMOM /.TRUE./
DATA KFCTRIG4 / 0., 0., 0.05, 0.05 /
DATA KFCRAD,KFCDEPTH,KFCDLEV
+ /1500., 4000., 0.5 /
DATA KFCDET,KFCTIMEC,KFCTIMEA
+ /0., 3600., 3600. /
*
TYPE = 'C'
*
GO TO 500
*
100 CONTINUE
*
DO I=1,NV
CALL LOW2UP(VALEURC(I),VALC(I))
END DO
*
IF (NOMC.EQ.'CONVEC') THEN
*
IF (MODEC.EQ.'SET') THEN
*
IF (VALC(1).EQ.'NIL') THEN
ICONVEC = 0
ELSE IF (VALC(1).EQ.'SEC') THEN
ICONVEC = 1
ELSE IF (VALC(1).EQ.'MANABE') THEN
ICONVEC = 2
ELSE IF (VALC(1).EQ.'OLDKUO') THEN
ICONVEC = 3
ELSE IF (VALC(1).EQ.'NEWKUO') THEN
ICONVEC = 4
ELSE IF (VALC(1).EQ.'FCP') THEN
ICONVEC = 5
ELSE IF (VALC(1).EQ.'KFC') THEN
ICONVEC = 6
ELSE IF (VALC(1).EQ.'KUOSTD') THEN
ICONVEC = 7
ELSE IF (VALC(1).EQ.'KUOSYM') THEN
ICONVEC = 8
ELSE IF (VALC(1).EQ.'KUOSUN') THEN
ICONVEC = 9
ELSE IF (VALC(1).EQ.'RAS') THEN
ICONVEC =10
ELSE IF (VALC(1).EQ.'FCPKUO') THEN
ICONVEC =11
ELSE IF (VALC(1).EQ.'KFCKUO2') THEN
ICONVEC =12
ELSE
WRITE(6,1010) NOMC,
+ 'SEC, MANABE, OLDKUO, NEWKUO, FCP, KFC,
+KUOSTD, KUOSYM, KUOSUN, RAS, FCPKUO2, FCPKUO,
+KFCKUO2, NIL'
CALL QQEXIT(1)
ENDIF
*
CONVEC = VALC(1)
*
ELSE IF (MODEC.EQ.'GET') THEN
*
VALEURC(1) = CONVEC
*
ENDIF
*
ELSE IF (NOMC.EQ.'FLUVERT') THEN
*
IF (MODEC.EQ.'SET') THEN
*
IF (VALC(1).EQ.'NIL') THEN
IFLUVERT = 0
ELSE IF (VALC(1).EQ.'PHYSIMP') THEN
IFLUVERT = 1
ELSE IF (VALC(1).EQ.'CLEF') THEN
IFLUVERT = 2
ELSE IF (VALC(1).EQ.'MOISTKE') THEN
IFLUVERT = 3
ELSE
WRITE(6,1010) NOMC,'MOISTKE, CLEF, PHYSIMP, NIL'
CALL QQEXIT(1)
ENDIF
*
FLUVERT = VALC(1)
*
ELSE IF (MODEC.EQ.'GET') THEN
*
VALEURC(1) = FLUVERT
*
ENDIF
*
ELSE IF (NOMC.EQ.'GWDRAG') THEN
*
IF (MODEC.EQ.'SET') THEN
*
IF (VALC(1).EQ.'NIL') THEN
IGWDRAG = 0
ELSE IF (VALC(1).EQ.'GWD86') THEN
IGWDRAG = 1
ELSE IF (VALC(1).EQ.'GWD95') THEN
IGWDRAG = 2
ELSE
WRITE(6,1010) NOMC,' GWD86, GWD95, NIL'
CALL QQEXIT(1)
ENDIF
*
GWDRAG = VALC(1)
*
ELSE IF (MODEC.EQ.'GET') THEN
*
VALEURC(1) = GWDRAG
*
ENDIF
*
ELSE IF (NOMC.EQ.'KFCPCP') THEN
*
IF (MODEC.EQ.'SET') THEN
*
IF (VALC(1).EQ.'ORI') THEN
IKFCPCP = 0
ELSE IF (VALC(1).EQ.'CONSPCPN') THEN
IKFCPCP = 1
ELSE
WRITE(6,1010) NOMC,' ORI, CONSPCPN'
CALL QQEXIT(1)
ENDIF
*
KFCPCP= VALC(1)
*
ELSE IF (MODEC.EQ.'GET') THEN
*
VALEURC(1) = KFCPCP
*
ENDIF
*
ELSE IF (NOMC.EQ.'LONGMEL') THEN
*
IF (MODEC.EQ.'SET') THEN
*
IF (VALC(1).EQ.'BLAC62') THEN
ILONGMEL= 0
ELSE IF (VALC(1).EQ.'BOUJO') THEN
ILONGMEL= 1
ELSE
WRITE(6,1010) NOMC,'BLAC62, BOUJO '
CALL QQEXIT(1)
ENDIF
*
LONGMEL = VALC(1)
*
ELSE IF (MODEC.EQ.'GET') THEN
*
VALEURC(1) = LONGMEL
ENDIF
*
ELSE IF (NOMC.EQ.'RADIA') THEN
*
IF (MODEC.EQ.'SET') THEN
*
IF (VALC(1).EQ.'NIL') THEN
IRADIA = 0
ELSE IF (VALC(1).EQ.'OLDRAD') THEN
IRADIA = 1
ELSE IF (VALC(1).EQ.'NEWRAD') THEN
IRADIA = 2
ELSE
WRITE(6,1010) NOMC,'NEWRAD, OLDRAD, NIL'
CALL QQEXIT(1)
ENDIF
*
RADIA = VALC(1)
*
ELSE IF (MODEC.EQ.'GET') THEN
*
VALEURC(1) = RADIA
*
ENDIF
*
ELSE IF (NOMC.EQ.'RADFILES') THEN
*
IF (MODEC.EQ.'SET') THEN
*
IF (VALC(1).NE.'UNF'.AND.VALC(1).NE.'STD') THEN
WRITE(6,1010) NOMC,'UNF, STD'
CALL QQEXIT(1)
ENDIF
*
RADFILES = VALC(1)
*
ELSE IF (MODEC.EQ.'GET') THEN
*
VALEURC(1) = RADFILES
*
ENDIF
*
ELSE IF (NOMC.EQ.'SHLCVT') THEN
*
IF (MODEC.EQ.'SET') THEN
*
IF (NV.NE.2) THEN
WRITE(6,1012) NOMC
CALL QQEXIT(1)
ENDIF
*
*
IF (VALC(1).EQ.'NIL') THEN
ISHLCVT(1) = 0
ELSE IF (VALC(1).EQ.'GELEYN') THEN
ISHLCVT(1) = 1
ELSE IF (VALC(1).EQ.'CONRES') THEN
ISHLCVT(1) = 2
ELSE IF (VALC(1).EQ.'SHALOW') THEN
ISHLCVT(1) = 3
ELSE IF (VALC(1).EQ.'SHALODQC') THEN
ISHLCVT(1) = 4
ELSE
WRITE(6,1010)'SHLCVT(1)','GELEYN,CONRES,SHALOW,SHALODQC,
+NIL'
CALL QQEXIT(1)
ENDIF
*
IF (VALC(2).EQ.'NIL') THEN
ISHLCVT(2) = 0
ELSE IF (VALC(2).EQ.'KTRSNT') THEN
ISHLCVT(2) = 1
ELSE
WRITE(6,1010) 'SHLCVT(2)','KTRSNT, NIL'
CALL QQEXIT(1)
ENDIF
DO I=1,NV
SHLCVT(I) = VALC(I)
END DO
*
ELSE IF (MODEC.EQ.'GET') THEN
*
*
IF (NV.NE.2) THEN
WRITE(6,1012) NOMC
CALL QQEXIT(1)
ENDIF
*
DO I=1,NV
VALEURC(I) = SHLCVT(I)
END DO
*
ENDIF
*
ELSE IF (NOMC.EQ.'STCOND') THEN
*
IF (MODEC.EQ.'SET') THEN
*
IF (VALC(1).EQ.'NIL') THEN
ISTCOND = 0
ELSE IF (VALC(1).EQ.'CONDS') THEN
ISTCOND = 1
ELSE IF (VALC(1).EQ.'OLDSUND') THEN
ISTCOND = 2
ELSE IF (VALC(1).EQ.'NEWSUND') THEN
ISTCOND = 3
ELSE IF (VALC(1).EQ.'CONSUN') THEN
ISTCOND = 4
ELSE IF (VALC(1).EQ.'EXC') THEN
ISTCOND = 5
ELSE IF (VALC(1).EQ.'EXCR1') THEN
ISTCOND = 6
ELSE IF (VALC(1).EQ.'EXCR2') THEN
ISTCOND = 7
ELSE IF (VALC(1).EQ.'EXCRI') THEN
ISTCOND = 8
ELSE IF (VALC(1).EQ.'EXCRIG') THEN
ISTCOND = 9
ELSE
WRITE(6,1010) NOMC,'CONDS, NEWSUND, OLDSUND,
+CONSUN, EXC, EXCR1, EXCR2, EXCRI, EXCRIG, NIL'
CALL QQEXIT(1)
ENDIF
*
STCOND = VALC(1)
*
ELSE IF (MODEC.EQ.'GET') THEN
*
VALEURC(1) = STCOND
*
ENDIF
*
ELSE IF (NOMC.EQ.'SCHMSOL') THEN
*
IF (MODEC.EQ.'SET') THEN
*
IF (VALC(1).EQ.'FCREST') THEN
ISCHMSOL = 1
ELSE IF (VALC(1).EQ.'CLASS') THEN
ISCHMSOL = 2
ELSE IF (VALC(1).EQ.'ISBA') THEN
ISCHMSOL = 3
ELSE
WRITE(6,1010) NOMC,'FCREST, CLASS, ISBA'
CALL QQEXIT(1)
ENDIF
*
SCHMSOL = VALC(1)
*
ELSE IF (MODEC.EQ.'GET') THEN
*
VALEURC(1) = SCHMSOL
*
ENDIF
*
ELSE IF (NOMC.EQ.'PCPTYPE') THEN
*
IF (MODEC.EQ.'SET') THEN
*
IF (VALC(1).EQ.'NIL') THEN
IPCPTYPE = 0
ELSE IF (VALC(1).EQ.'BOURGE') THEN
IPCPTYPE = 1
ELSE
WRITE(6,1010) NOMC,'BOURGE'
CALL QQEXIT(1)
ENDIF
*
PCPTYPE = VALC(1)
*
ELSE IF (MODEC.EQ.'GET') THEN
*
VALEURC(1) = PCPTYPE
*
ENDIF
*
ELSE
*
WRITE(6,1020) NOMC,'CONVEC, FLUVERT, GWDRAG, LONGMEL, '
WRITE(6,1021) 'RADIA,SCHMSOL,STCOND,SHLCVT,KFCPCP'
WRITE(6,1021) 'PCPTYPE '
WRITE(6,1022)
CALL QQEXIT(1)
*
ENDIF
*
RETURN
*
ENTRY PHYOPTI (NOM,VALEURI,NV,MODE)
*
*Author
* B. Bilodeau (Spring 1994)
*
*Object
* to initialize the physics comdeck OPTIONS
*
*Arguments
*
* - Input -
* NOM name of the option to be treated
*
* - Input/Output -
* VALEURI value of the integer constant
*
* - Input -
* NV number of values to be treated
* MODE mode of operation : SET = initialize the value
* GET = extract the value
**
*
TYPE = 'I'
GO TO 500
*
200 CONTINUE
*
IF (NOMC.EQ.'DATE') THEN
*
IF (MODEC.EQ.'SET') THEN
DO 55 I=1,NV
DATE(I) = VALEURI(I)
55 CONTINUE
ELSE IF (MODEC.EQ.'GET') THEN
DO 56 I=1,NV
VALEURI(I) = DATE(I)
56 CONTINUE
ENDIF
*
ELSE IF (NOMC.EQ.'DEBUT') THEN
*
IF (MODEC.EQ.'SET') THEN
DEBUT = VALEURI(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURI(1) = DEBUT
ENDIF
*
ELSE IF (NOMC.EQ.'ICONVEC') THEN
*
IF (MODEC.EQ.'GET') THEN
VALEURI(1) = ICONVEC
ENDIF
*
ELSE IF (NOMC.EQ.'IKFCPCP') THEN
*
IF (MODEC.EQ.'GET') THEN
VALEURI(1) = IKFCPCP
ENDIF
*
ELSE IF (NOMC.EQ.'ISTCOND') THEN
*
IF (MODEC.EQ.'GET') THEN
VALEURI(1) = ISTCOND
ENDIF
*
ELSE IF (NOMC.EQ.'MOYHR') THEN
*
IF (MODEC.EQ.'SET') THEN
MOYHR = VALEURI(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURI(1) = MOYHR
ENDIF
*
ELSE IF (NOMC.EQ.'NSLOFLUX') THEN
*
IF (MODEC.EQ.'SET') THEN
NSLOFLUX = VALEURI(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURI(1) = NSLOFLUX
ENDIF
*
ELSE IF (NOMC.EQ.'KNTRAD') THEN
*
IF (MODEC.EQ.'SET') THEN
KNTRAD = VALEURI(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURI(1) = KNTRAD
ENDIF
*
ELSE IF (NOMC.EQ.'LIN_KPH') THEN
*
IF (MODEC.EQ.'SET') THEN
LIN_KPH = VALEURI(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURI(1) = LIN_KPH
ENDIF
*
ELSE IF (NOMC.EQ.'LIN_LSC') THEN
*
IF (MODEC.EQ.'SET') THEN
LIN_LSC = VALEURI(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURI(1) = LIN_LSC
ENDIF
*
ELSE IF (NOMC.EQ.'LIN_PBL') THEN
*
IF (MODEC.EQ.'SET') THEN
LIN_PBL = VALEURI(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURI(1) = LIN_PBL
ENDIF
*
ELSE IF (NOMC.EQ.'LIN_SGO') THEN
*
IF (MODEC.EQ.'SET') THEN
LIN_SGO = VALEURI(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURI(1) = LIN_SGO
ENDIF
*
ELSE IF (NOMC.EQ.'LIN_V4D') THEN
*
IF (MODEC.EQ.'SET') THEN
LIN_V4d = VALEURI(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURI(1) = LIN_V4D
ENDIF
*
ELSE IF (NOMC.EQ.'RADNIV') THEN
IF (MODEC.EQ.'SET') THEN
IF (VALEURI(1).NE.0) THEN
DO I=1,NV
RADNIVL(I) = VALEURI(I)
ENDDO
ENDIF
ELSE IF (MODEC.EQ.'GET') THEN
DO I=1,NV
VALEURI(I) = RADNIVL(I)
ENDDO
ENDIF
*
ELSE
*
WRITE(6,1020) NOMC,'DATE, DEBUT, KNTRAD, RADNIVL '
WRITE(6,1022)
CALL QQEXIT(1)
*
ENDIF
*
RETURN
*
ENTRY PHYOPTL (NOM,VALEURL,NV,MODE)
*
*Author
* B. Bilodeau (Spring 1994)
*
*Object
* to initialize the physics comdeck OPTIONS
*
*Arguments
*
* - Input -
* NOM name of the option to be treated
*
* - Input/Output -
* VALEURL value of the logical constant
*
* - Input -
* NV number of values to be treated
* MODE mode of operation : SET = initialize the value
* GET = extract the value
**
*
TYPE = 'L'
GO TO 500
*
300 CONTINUE
*
*
IF (NOMC.EQ.'ADVECTKE') THEN
*
IF (MODEC.EQ.'SET') THEN
ADVECTKE = VALEURL(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURL(1) = ADVECTKE
ENDIF
*
ELSE IF (NOMC.EQ.'AGREGAT') THEN
*
IF (MODEC.EQ.'SET') THEN
AGREGAT = VALEURL(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURL(1) = AGREGAT
ENDIF
*
ELSE IF (NOMC.EQ.'CHAUF') THEN
*
IF (MODEC.EQ.'SET') THEN
CHAUF = VALEURL(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURL(1) = CHAUF
ENDIF
*
ELSE IF (NOMC.EQ.'CLIMAT') THEN
*
IF (MODEC.EQ.'SET') THEN
CLIMAT = VALEURL(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURL(1) = CLIMAT
ENDIF
*
ELSE IF (NOMC.EQ.'DBGMEM') THEN
*
IF (MODEC.EQ.'SET') THEN
DBGMEM = VALEURL(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURL(1) = DBGMEM
ENDIF
*
ELSE IF (NOMC.EQ.'DIFFUW') THEN
*
IF (MODEC.EQ.'SET') THEN
DIFFUW = VALEURL(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURL(1) = DIFFUW
ENDIF
*
ELSE IF (NOMC.EQ.'DMOM') THEN
*
IF (MODEC.EQ.'SET') THEN
DMOM = VALEURL(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURL(1) = DMOM
ENDIF
*
ELSE IF (NOMC.EQ.'DRAG') THEN
*
IF (MODEC.EQ.'SET') THEN
DRAG = VALEURL(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURL(1) = DRAG
ENDIF
*
ELSE IF (NOMC.EQ.'EVAP') THEN
*
IF (MODEC.EQ.'SET') THEN
EVAP = VALEURL(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURL(1) = EVAP
ENDIF
*
ELSE IF (NOMC.EQ.'ICEMELT') THEN
*
IF (MODEC.EQ.'SET') THEN
ICEMELT = VALEURL(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURL(1) = ICEMELT
ENDIF
*
ELSE IF (NOMC.EQ.'IMPFLX') THEN
*
IF (MODEC.EQ.'SET') THEN
IMPFLX = VALEURL(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURL(1) = IMPFLX
ENDIF
*
ELSE IF (NOMC.EQ.'INILWC') THEN
*
IF (MODEC.EQ.'SET') THEN
INILWC = VALEURL(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURL(1) = INILWC
ENDIF
*
ELSE IF (NOMC.EQ.'KFCMOM') THEN
*
IF (MODEC.EQ.'SET') THEN
KFCMOM=VALEURL(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURL(1)= KFCMOM
ENDIF
*
ELSE IF (NOMC.EQ.'RADFIX') THEN
*
IF (MODEC.EQ.'SET') THEN
RADFIX = VALEURL(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURL(1) = RADFIX
ENDIF
*
ELSE IF (NOMC.EQ.'RADFLTR') THEN
*
IF (MODEC.EQ.'SET') THEN
RADFLTR = VALEURL(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURL(1) = RADFLTR
ENDIF
*
ELSE IF (NOMC.EQ.'SATUCO') THEN
*
IF (MODEC.EQ.'SET') THEN
SATUCO = VALEURL(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURL(1) = SATUCO
ENDIF
*
ELSE IF (NOMC.EQ.'SNOALB_ANL') THEN
*
IF (MODEC.EQ.'SET') THEN
SNOALB_ANL = VALEURL(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURL(1) = SNOALB_ANL
ENDIF
*
ELSE IF (NOMC.EQ.'SNOWMELT') THEN
*
IF (MODEC.EQ.'SET') THEN
SNOWMELT = VALEURL(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURL(1) = SNOWMELT
ENDIF
*
ELSE IF (NOMC.EQ.'STOMATE') THEN
*
IF (MODEC.EQ.'SET') THEN
STOMATE = VALEURL(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURL(1) = STOMATE
ENDIF
*
ELSE IF (NOMC.EQ.'STRATOS') THEN
*
IF (MODEC.EQ.'SET') THEN
STRATOS = VALEURL(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURL(1) = STRATOS
ENDIF
*
ELSE IF (NOMC.EQ.'TSCONFC') THEN
*
IF (MODEC.EQ.'SET') THEN
TSCONFC = VALEURL(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURL(1) = TSCONFC
ENDIF
*
ELSE IF (NOMC.EQ.'TYPSOL') THEN
*
IF (MODEC.EQ.'SET') THEN
TYPSOL = VALEURL(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURL(1) = TYPSOL
ENDIF
*
ELSE IF (NOMC.EQ.'WET') THEN
*
IF (MODEC.EQ.'SET') THEN
WET = VALEURL(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURL(1) = WET
ENDIF
*
ELSE IF (NOMC.EQ.'Z0DIR') THEN
*
IF (MODEC.EQ.'SET') THEN
Z0DIR = VALEURL(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURL(1) = Z0DIR
ENDIF
*
ELSE IF (NOMC.EQ.'Z0TCST') THEN
*
IF (MODEC.EQ.'SET') THEN
Z0TCST = VALEURL(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURL(1) = Z0TCST
ENDIF
*
ELSE IF (NOMC.EQ.'CORTM') THEN
*
IF (MODEC.EQ.'SET') THEN
CORTM = VALEURL(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURL(1) = CORTM
ENDIF
*
ELSE IF (NOMC.EQ.'CORTS') THEN
*
IF (MODEC.EQ.'SET') THEN
CORTS = VALEURL(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURL(1) = CORTS
ENDIF
*
ELSE IF (NOMC.EQ.'DRYLAPS') THEN
*
IF (MODEC.EQ.'SET') THEN
DRYLAPS = VALEURL(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURL(1) = DRYLAPS
ENDIF
*
ELSE IF (NOMC.EQ.'MONTAGN') THEN
*
IF (MODEC.EQ.'SET') THEN
MONTAGN = VALEURL(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURL(1) = MONTAGN
ENDIF
*
ELSE IF (NOMC.EQ.'BKGALB') THEN
*
IF (MODEC.EQ.'SET') THEN
BKGALB = VALEURL(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURL(1) = BKGALB
ENDIF
*
ELSE IF (NOMC.EQ.'FOMICHEV') THEN
*
IF (MODEC.EQ.'SET') THEN
FOMIC = VALEURL(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURL(1) = FOMIC
ENDIF
*
ELSE
*
WRITE(6,1020) NOMC,'ADVECTKE, DIFFUW, CHAUF, CLIMAT,'
WRITE(6,1021) 'DBGMEM, DMOM, DRAG, EVAP, FOMIC, '
WRITE(6,1021) 'INILWC, KFCMOM, RADFIX, RADFLTR, '
WRITE(6,1021) 'SATUCO, SNOWMELT, STOMATE, STRATOS,'
WRITE(6,1021) 'TYPSOL, WET, Z0DIR, CORTM, CORTS, '
WRITE(6,1021) 'DRYLAPS, MONTAGN, BKGALB,IMPFLX '
WRITE(6,1022)
CALL QQEXIT(1)
*
ENDIF
*
RETURN
*
ENTRY PHYOPTR (NOM,VALEURR,NV,MODE)
*
*Author
* B. Bilodeau (Spring 1994)
*
*Object
* to initialize the physics comdeck OPTIONS
*
*Arguments
*
* - Input -
* NOM name of the option to be treated
*
* - Input/Output -
* VALEURR value of the real constant
*
* - Input -
* NV number of values to be treated
* MODE mode of operation : SET = initialize the value
* GET = extract the value
**
*
TYPE = 'R'
GO TO 500
*
400 CONTINUE
*
IF (NOMC.EQ.'AS') THEN
*
IF (MODEC.EQ.'SET') THEN
AS2 = VALEURR(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURR(1) = AS2
ENDIF
*
ELSE IF (NOMC.EQ.'BETA') THEN
*
IF (MODEC.EQ.'SET') THEN
BETA2 = VALEURR(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURR(1) = BETA2
ENDIF
*
ELSE IF (NOMC.EQ.'DELT') THEN
*
IF (MODEC.EQ.'SET') THEN
DELT = VALEURR(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURR(1) = DELT
ENDIF
*
ELSE IF (NOMC.EQ.'DZSEDI') THEN
*
IF (MODEC.EQ.'SET') THEN
DZSEDI = VALEURR(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURR(1) = DZSEDI
ENDIF
*
ELSE IF (NOMC.EQ.'EPONGE') THEN
*
IF (MODEC.EQ.'SET') THEN
DO I=1,NV
EPONGE(I) = VALEURR(I)
END DO
ELSE IF (MODEC.EQ.'GET') THEN
DO I=1,NV
VALEURR(I) = EPONGE(I)
END DO
ENDIF
*
ELSE IF (NOMC.EQ.'ETRMIN') THEN
*
IF (MODEC.EQ.'SET') THEN
ETRMIN2 = VALEURR(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURR(1) = ETRMIN2
ENDIF
*
ELSE IF (NOMC.EQ.'FACDIFV') THEN
*
IF (MODEC.EQ.'SET') THEN
FACDIFV = VALEURR(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURR(1) = FACDIFV
ENDIF
*
ELSE IF (NOMC.EQ.'FACTDT') THEN
*
IF (MODEC.EQ.'SET') THEN
FACTDT = VALEURR(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURR(1) = FACTDT
ENDIF
*
ELSE IF (NOMC.EQ.'HC') THEN
*
IF (MODEC.EQ.'SET') THEN
IF (VALEURR(1).GT.1.0 .OR.
+ VALEURR(1).LT.0.0) THEN
WRITE(6,1010) NOMC,'0.0 <= HC <= 1.0'
CALL QQEXIT(1)
ENDIF
HC2 = VALEURR(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURR(1) = HC2
ENDIF
*
ELSE IF (NOMC.EQ.'HF') THEN
*
IF (MODEC.EQ.'SET') THEN
*
IF (VALEURR(1).GT.1.0 .OR.
+ VALEURR(1).LT.0.0) THEN
WRITE(6,1010) NOMC,'0.0 <= HF <= 1.0'
CALL QQEXIT(1)
ENDIF
HF2 = VALEURR(1)
*
ELSE IF (MODEC.EQ.'GET') THEN
*
VALEURR(1) = HF2
*
ENDIF
*
ELSE IF (NOMC.EQ.'HM') THEN
*
IF (MODEC.EQ.'SET') THEN
*
IF (VALEURR(1).GT.1.0 .OR.
+ VALEURR(1).LT.0.0) THEN
WRITE(6,1010) NOMC,'0.0 <= HM <= 1.0'
CALL QQEXIT(1)
ENDIF
HM2 = VALEURR(1)
*
ELSE IF (MODEC.EQ.'GET') THEN
*
VALEURR(1) = HM2
*
ENDIF
*
ELSE IF (NOMC.EQ.'KFCDEPTH') THEN
*
IF (MODEC.EQ.'SET') THEN
KFCDEPTH= VALEURR(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURR(1) =KFCDEPTH
ENDIF
*
ELSE IF (NOMC.EQ.'KFCDET') THEN
*
IF (MODEC.EQ.'SET') THEN
KFCDET= VALEURR(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURR(1) =KFCDET
ENDIF
*
ELSE IF (NOMC.EQ.'KFCDLEV') THEN
*
IF (MODEC.EQ.'SET') THEN
KFCDLEV= VALEURR(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURR(1) =KFCDLEV
ENDIF
*
ELSE IF (NOMC.EQ.'KFCRAD') THEN
*
IF (MODEC.EQ.'SET') THEN
KFCRAD= VALEURR(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURR(1) =KFCRAD
ENDIF
*
ELSE IF (NOMC.EQ.'KFCTIMEA') THEN
*
IF (MODEC.EQ.'SET') THEN
KFCTIMEA= VALEURR(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURR(1) =KFCTIMEA
ENDIF
*
ELSE IF (NOMC.EQ.'KFCTIMEC') THEN
*
IF (MODEC.EQ.'SET') THEN
KFCTIMEC= VALEURR(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURR(1) =KFCTIMEC
ENDIF
*
ELSE IF (NOMC.EQ.'KFCTRIG4') THEN
*
IF (MODEC.EQ.'SET') THEN
KFCTRIG4(1) = VALEURR(1)
KFCTRIG4(2) = VALEURR(2)
KFCTRIG4(3) = VALEURR(3)
KFCTRIG4(4) = VALEURR(4)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURR(1) = KFCTRIG4(1)
VALEURR(2) = KFCTRIG4(2)
VALEURR(3) = KFCTRIG4(3)
VALEURR(4) = KFCTRIG4(4)
ENDIF
*
ELSE IF (NOMC.EQ.'KKL') THEN
*
IF (MODEC.EQ.'SET') THEN
KKL2 = VALEURR(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURR(1) = KKL2
ENDIF
*
ELSE IF (NOMC.EQ.'PARSOL') THEN
*
IF (MODEC.EQ.'SET') THEN
DO I=1,NV
PARSOL(I) = VALEURR(I)
END DO
ELSE IF (MODEC.EQ.'GET') THEN
DO I=1,NV
VALEURR(I) = PARSOL(I)
END DO
ENDIF
*
ELSE IF (NOMC.EQ.'QCO2') THEN
*
IF (MODEC.EQ.'SET') THEN
QCO2 = VALEURR(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURR(1) = QCO2
ENDIF
*
ELSE IF (NOMC.EQ.'TAUFAC') THEN
*
IF (MODEC.EQ.'SET') THEN
TAUFAC = VALEURR(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURR(1) = TAUFAC
ENDIF
*
ELSE IF (NOMC.EQ.'Z0MIN') THEN
*
IF (MODEC.EQ.'SET') THEN
Z0MIN2 = VALEURR(1)
ELSE IF (MODEC.EQ.'GET') THEN
VALEURR(1) = Z0MIN2
ENDIF
*
ELSE
*
WRITE(6,1020) NOMC,'AS, BETA, DELT, DZSEDI, '
WRITE(6,1021) 'EPONGE, ETRMIN, FACDIFV, FACTDT, '
WRITE(6,1021) 'HC, HF, HM, KFCDEPTH, KFCDET, '
WRITE(6,1021) 'KFCDLEV, KFCMOM, KFCPCP, KFCRAD, '
WRITE(6,1021) 'KFCTIMEC, KFCTIMEA, KFCTRIG, '
WRITE(6,1021) 'KKL,PARSOL, QCO2, TAUFAC, Z0MIN '
WRITE(6,1022)
CALL QQEXIT(1)
*
ENDIF
*
RETURN
*
************************************************************************
*
* SECTION COMMUNE AUX POINTS D'ENTREE
*
************************************************************************
*
500 CONTINUE
*
* CONVERSION DE MINUSCULES A MAJUSCULES
*
CALL LOW2UP(NOM, NOMC)
CALL LOW2UP(MODE,MODEC)
*
* VERIFICATION DU MODE D'OPERATION
*
IF (MODEC.NE.'SET' .AND. MODEC.NE.'GET') THEN
WRITE(6,1000)
CALL QQEXIT(1)
ENDIF
*
* RETOUR AUX POINTS D'ENTREE
*
IF (TYPE.EQ.'C') THEN
GO TO 100
ELSE IF (TYPE.EQ.'I') THEN
GO TO 200
ELSE IF (TYPE.EQ.'L') THEN
GO TO 300
ELSE IF (TYPE.EQ.'R') THEN
GO TO 400
ENDIF
************************************************************************
*
* FIN DE LA SECTION COMMUNE
*
************************************************************************
*
*
1000 FORMAT ( ' *****************************************',
+ / ' *****************************************',
+ / ' * *',
+ / ' ***** ABORT ***** ABORT ***** ABORT *****',
+ / ' * *',
+ / ' * S/R PHYOPT: INVALID MODE *',
+ / ' * *',
+ / ' * USE EITHER SET OR GET *',
+ / ' * *',
+ / ' *****************************************',
+ / ' *****************************************')
*
1010 FORMAT ( ' *****************************************',
+ / ' *****************************************',
+ / ' * *',
+ / ' ***** ABORT ***** ABORT ***** ABORT *****',
+ / ' * *',
+ / ' * S/R PHYOPT : ILLEGAL VALUE *',
+ / ' * FOR OPTION ', A9, ' *',
+ / ' * ALLOWED :',A,' *',
+ / ' * *',
+ / ' *****************************************',
+ / ' *****************************************')
*
1012 FORMAT ( ' *****************************************',
+ / ' *****************************************',
+ / ' * *',
+ / ' ***** ABORT ***** ABORT ***** ABORT *****',
+ / ' * *',
+ / ' * S/R PHYOPT : ILLEGAL NUMBER *',
+ / ' * OF VALUES FOR OPTION ', A8 ' *',
+ / ' * *',
+ / ' *****************************************',
+ / ' *****************************************')
*
1020 FORMAT (2(1x,60('*')/),1x,'*',58(' '),'*'/
+ 1x,5('***** ABORT'),'*****'/1x,'*',58(' '),'*'/
+ ' *',9(' '),"S/R PHYOPT: INVALID OPTION: '",A8,"'",
+ 10(' '),'*'/' * ','ALLOWED: ',a,13(' '),'*',)
1021 FORMAT (' * ',a,11(' '),'*',)
1022 FORMAT (1x,'*',58(' '),'*',/2(1x,60('*')/))
*
*
END