*=*=*=*= SUCST.html =*=*=*=*
SUBROUTINE SUCST(KULOUT,KDAT,KSSS,pg,prad,pmugaz,pkappa, s pdaysec) C C**** *SUCST * - Routine to initialize the constants of the model. C C Purpose. C -------- C Initialize and print the common YOMCST + initialize C date and time of YOMRIP. C C** Interface. C ---------- C *CALL* *SUCST (kulout,kdat,ksss) C C Explicit arguments : C -------------------- C C KULOUT logical unit for the output C KDAT date in the form AAAAMMDD C KSSS number of seconds in the day C C Implicit arguments : C -------------------- C COMMON YOMCST C C Method. C ------- C See documentation C C Externals. C ---------- C C Reference. C ---------- C ECMWF research department documentation of the C "in core model" C C Author. C ------- C Mats Hamrud and Philippe Courtier *ECMWF* C C Modifications. C -------------- C Original : 87-10-15 C ------------------------------------------------------------------ #include "planete.h" #include "yomcst.h" #include "yomrip.h" REAL pg,prad,pmugaz,pkappa,pdaysec C ----------------------------------------------------------- C C - Astronomical functions C you will find the description in the annex 1 of the documentation C RRS is the distance Sun-Earth C RDS is the declination of the Earth C RET is the equation of time C C Orbit of the earth RTETA(PTIME)=PTIME/(RDAY*365.25) REL(PTETA)=1.7535+6.283076*PTETA REM(PTETA)=6.240075+6.283020*PTETA RRS(PTETA)=REA*(1.0001-0.0163*SIN(REL(PTETA)) S +0.0037*COS(REL(PTETA))) C Relative movement Sun/Earth RLLS(PTETA)=4.8951+6.283076*PTETA RLLLS(PTETA)=4.8952+6.283320*PTETA-0.0075*SIN(REL(PTETA)) S -0.0326*COS(REL(PTETA))-0.0003*SIN(2.*REL(PTETA)) S +0.0002*COS(2.*REL(PTETA)) RDS(PTETA)=ASIN(SIN(REPSM)*SIN(RLLLS(PTETA))) RET(PTETA)=591.8*SIN(2.*RLLS(PTETA))-459.4*SIN(REM(PTETA)) S +39.5*SIN(REM(PTETA))*COS(2.*RLLS(PTETA)) S -12.7*SIN(4.*RLLS(PTETA))-4.8*SIN(2.*REM(PTETA)) C ------------------------------------------------------------- C ------------------------------------------------------------ C C - thermodynamical functions C C RLV : Latent heat of vapourisation C RLS : Latent heat of sublimation C RLF : Latent heat of fusion C ESW : saturation in presence of water C ESS : saturation in presence of ice C ES : saturation (T>Tt then water TRLV(QQQQQT)=RLVTT+(RCPV-RCW)*(QQQQQT-RTT) RLS(QQQQQT)=RLSTT+(RCPV-RCS)*(QQQQQT-RTT) RLF(QQQQQT)=RLS(QQQQQT)-RLV(QQQQQT) ESW(QQQQQT)=EXP(RALPW-RBETW/QQQQQT-RGAMW*ALOG(QQQQQT)) ESS(QQQQQT)=EXP(RALPS-RBETS/QQQQQT-RGAMS*ALOG(QQQQQT)) EZZ(QQQQQT,QQQQQA,QQQQQB)=(.5+SIGN(.5,QQQQQT-RTT))*QQQQQA s +(.5-SIGN(.5,QQQQQT-RTT))*QQQQQB ES (QQQQQT)=EXP(EZZ(QQQQQT,RALPW,RALPS) s -EZZ(QQQQQT,RBETW,RBETS)/QQQQQT s -EZZ(QQQQQT,RGAMW,RGAMS)*ALOG(QQQQQT) ) C ------------------------------------------------------------- C ------------------------------------------------------------ C C - Time functions C the descriptions are in the annex 1 of the documentation C C TIME C C NDD : extraxt dd from ccaammdd C NMM : extract mm from ccaammdd C NAA : extract aa from ccaammdd C NCCAA : extract ccaa from ccaammdd C NAMD : extract aammdd from ccaammdd C NCTH : turn seconds into hours C RTIME : returns the time of the model (in seconds of course!) C NDD(KGRDAT) =MOD(KGRDAT,100) NMM(KGRDAT) =MOD((KGRDAT-NDD(KGRDAT))/100,100) NCCAA(KGRDAT)=KGRDAT/10000 NAA(KGRDAT)=MOD(NCCAA(KGRDAT),100) NAMD(KGRDAT)=MOD(KGRDAT,1000000) NCTH(KSEC)=KSEC/3600 C NZZAA(KAAAA,KMM)=KAAAA-( (1-ISIGN(1,KMM-3))/2 ) NZZMM(KMM)=KMM+6*(1-ISIGN(1,KMM-3)) RJUDAT(KAAAA,KMM,KDD)=1720994.5 + FLOAT( S 2-NZZAA(KAAAA,KMM)/100 + (NZZAA(KAAAA,KMM)/100)/4 S + INT(365.25*FLOAT(NZZAA(KAAAA,KMM))) S + INT(30.601*FLOAT(NZZMM(KMM)+1)) S + KDD) RTIME(KAAAA,KMM,KDD,KSS)=(RJUDAT(KAAAA,KMM,KDD)-2451545.) S *RDAY+FLOAT(KSS) C ------------------------------------------------------------- C ----------------------------------------------------------------- C C* 1. DEFINE FUNDAMENTAL CONSTANTS. C ----------------------------- C 100 CONTINUE C WRITE(UNIT=KULOUT,FMT='(''0*** Constants of the ICM ***'')') RPI=2.*ASIN(1.) RCLUM=299792458. RHPLA=6.6260755E-34 RKBOL=1.380658E-23 RNAVO=6.0221367E+23 WRITE(UNIT=KULOUT,FMT='('' *** Fundamental constants ***'')') WRITE(UNIT=KULOUT,FMT='('' PI = '',E13.7,'' -'')')RPI WRITE(UNIT=KULOUT,FMT='('' c = '',E13.7,''m s-1'')') S RCLUM WRITE(UNIT=KULOUT,FMT='('' h = '',E13.7,''J s'')') S RHPLA WRITE(UNIT=KULOUT,FMT='('' K = '',E13.7,''J K-1'')') S RKBOL WRITE(UNIT=KULOUT,FMT='('' N = '',E13.7,''mol-1'')') S RNAVO C C ---------------------------------------------------------------- C C* 2. DEFINE ASTRONOMICAL CONSTANTS. C ------------------------------ C 200 CONTINUE C C RDAY=86400. C REA=149597870000. C REPSM=0.409093 C RDAY=pdaysec c !!! les deux parametres suivants sont a changer mais pas utilises REA=246280000000. REPSM=0.409093 C c !!! a changer egalement RSIYEA=365.25*RDAY*2.*RPI/6.283076 RSIDAY=RDAY/(1.+RDAY/RSIYEA) ROMEGA=2.*RPI/RSIDAY WRITE(UNIT=KULOUT,FMT='('' *** Astronomical constants ***'')') WRITE(UNIT=KULOUT,FMT='('' day = '',E13.7,'' s'')')RDAY WRITE(UNIT=KULOUT,FMT='('' half g. axis = '',E13.7,'' m'')')REA WRITE(UNIT=KULOUT,FMT='('' mean anomaly = '',E13.7,'' -'')')REPSM WRITE(UNIT=KULOUT,FMT='('' sideral day = '',E13.7,'' s'')')RSIDAY WRITE(UNIT=KULOUT,FMT='('' omega = '',E13.7,'' s-1'')') S ROMEGA C IDAT=KDAT ISSS=KSSS ID=NDD(IDAT) IM=NMM(IDAT) IA=NCCAA(IDAT) ZJU=RJUDAT(IA,IM,ID) ZTI=RTIME(IA,IM,ID,ISSS) RTIMST=ZTI RTIMTR=ZTI WRITE(UNIT=KULOUT,FMT='('' The initial date of the run is :'')') WRITE(UNIT=KULOUT,FMT='(1X,I8,1X,I5,5X,I4,1X,I2,1X,I2)') S IDAT,ISSS,IA,IM,ID WRITE(UNIT=KULOUT,FMT='('' The Julian date is : '',F11.2)') ZJU WRITE(UNIT=KULOUT,FMT='('' Time of the model : '',F15.2,'' s'')') S ZTI ZTETA=RTETA(ZTI) ZRS=RRS(ZTETA) ZDE=RDS(ZTETA) ZET=RET(ZTETA) WRITE(UNIT=KULOUT,FMT='('' Distance Earth-Sun : '',E13.7,'' m'')') S ZRS WRITE(UNIT=KULOUT,FMT='('' Declination : '',F12.5)') ZDE WRITE(UNIT=KULOUT,FMT='('' Eq. of time : '',F12.5,'' s'')') S ZET C C ------------------------------------------------------------------ C C* 3. DEFINE GEOIDE. C -------------- C 300 CONTINUE C RG=pg RA=prad R1SA=SNGL(1.D0/DBLE(RA)) WRITE(UNIT=KULOUT,FMT='('' *** Geoide ***'')') WRITE(UNIT=KULOUT,FMT='('' Gravity = '',E13.7,'' m s-2'')') S RG WRITE(UNIT=KULOUT,FMT='('' Earth radius = '',E13.7,'' m'')')RA C C ----------------------------------------------------------------- C C* 4. DEFINE RADIATION CONSTANTS. C --------------------------- C 400 CONTINUE C C RSIGMA=2. * RPI**5 * RKBOL**4 /(15 * RCLUM**2 * RHPLA**3) RSIGMA=1.e-6 * 2. * RPI**5 *(RKBOL*1.e+23)**4 / $ (15 *(RCLUM*1.e-8)**2 * (RHPLA*1.e+34)**3) RI0=1370. WRITE(UNIT=KULOUT,FMT='('' *** Radiation ***'')') WRITE(UNIT=KULOUT,FMT='('' Stefan-Bol. = '',E13.7,'' W m-2 K-4'' S )') RSIGMA WRITE(UNIT=KULOUT,FMT='('' Solar const. = '',E13.7,'' W m-2'')') S RI0 C C ----------------------------------------------------------------- C C* 5. DEFINE THERMODYNAMIC CONSTANTS, GAS PHASE. C ------------------------------------------ C 500 CONTINUE C R=RNAVO*RKBOL RMD=pmugaz c !!! masse moleculaire de la vapeur d'eau c les suffixes V correspondent a la vapeur d'eau RMV=18.0153 RD=1000.*R/RMD RV=1000.*R/RMV RCPD=RD/pkappa RCVD=RCPD-RD RCPV=4. *RV RCVV=RCPV-RV RDELTA=RCPV/RCPD RDELM1=RDELTA-1. RKAPPA=RD/RCPD REPSI=RD/RV R1M1E=1./REPSI-1. WRITE(UNIT=KULOUT,FMT='('' *** Thermodynamic, gas ***'')') WRITE(UNIT=KULOUT,FMT='('' Perfect gas = '',e13.7)') R WRITE(UNIT=KULOUT,FMT='('' Dry air mass = '',e13.7)') RMD WRITE(UNIT=KULOUT,FMT='('' Vapour mass = '',e13.7)') RMV WRITE(UNIT=KULOUT,FMT='('' Dry air cst. = '',e13.7)') RD WRITE(UNIT=KULOUT,FMT='('' Vapour cst. = '',e13.7)') RV WRITE(UNIT=KULOUT,FMT='('' Cpd = '',e13.7)') RCPD WRITE(UNIT=KULOUT,FMT='('' Cvd = '',e13.7)') RCVD WRITE(UNIT=KULOUT,FMT='('' Cpv = '',e13.7)') RCPV WRITE(UNIT=KULOUT,FMT='('' Cvv = '',e13.7)') RCVV C C ---------------------------------------------------------------- C C* 6. DEFINE THERMODYNAMIC CONSTANTS, LIQUID PHASE. C --------------------------------------------- C 600 CONTINUE C RCW=4218. WRITE(UNIT=KULOUT,FMT='('' *** Thermodynamic, liquid ***'')') WRITE(UNIT=KULOUT,FMT='('' Cw = '',E13.7)') RCW C C ---------------------------------------------------------------- C C* 7. DEFINE THERMODYNAMIC CONSTANTS, SOLID PHASE. C -------------------------------------------- C 700 CONTINUE C RCS=2106. WRITE(UNIT=KULOUT,FMT='('' *** thermodynamic, solid ***'')') WRITE(UNIT=KULOUT,FMT='('' Cs = '',E13.7)') RCS C C ---------------------------------------------------------------- C C* 8. DEFINE THERMODYNAMIC CONSTANTS, TRANSITION OF PHASE. C ---------------------------------------------------- C 800 CONTINUE C RTT=273.16 RLVTT=2.5008E+6 RLSTT=2.8345E+6 RATM=100000. WRITE(UNIT=KULOUT,FMT='('' *** Thermodynamic, trans. ***'')') WRITE(UNIT=KULOUT,FMT='('' Fusion point = '',E13.7)') RTT WRITE(UNIT=KULOUT,FMT='('' RLvTt = '',E13.7)') RLVTT WRITE(UNIT=KULOUT,FMT='('' RLsTt = '',E13.7)') RLSTT WRITE(UNIT=KULOUT,FMT='('' Normal press. = '',E13.7)') RATM WRITE(UNIT=KULOUT,FMT='('' Latent heat : '')') WRITE(UNIT=KULOUT,FMT='(10(1X,E10.4))') (10.*I,I=-4,4) WRITE(UNIT=KULOUT,FMT='(10(1X,E10.4))') (RLV(RTT+10.*I),I=-4,4) WRITE(UNIT=KULOUT,FMT='(10(1X,E10.4))') (RLS(RTT+10.*I),I=-4,4) C C ---------------------------------------------------------------- C C* 9. SATURATED VAPOUR PRESSURE. C -------------------------- C 900 CONTINUE C RESTT=611.14 RGAMW=(RCW-RCPV)/RV RBETW=RLV(RTT)/RV+RGAMW*RTT RALPW=ALOG(RESTT)+RBETW/RTT+RGAMW*ALOG(RTT) RGAMS=(RCS-RCPV)/RV RBETS=RLS(RTT)/RV+RGAMS*RTT RALPS=ALOG(RESTT)+RBETS/RTT+RGAMS*ALOG(RTT) WRITE(UNIT=KULOUT,FMT='('' *** Thermodynamic, satur. ***'')') WRITE(UNIT=KULOUT,FMT='('' Fusion point = '',E13.7)') RTT WRITE(UNIT=KULOUT,FMT='('' es(Tt) = '',e13.7)') RESTT WRITE(UNIT=KULOUT,FMT='('' es(T) : '')') WRITE(UNIT=KULOUT,FMT='(10(1X,E10.4))') (10.*I,I=-4,4) WRITE(UNIT=KULOUT,FMT='(10(1X,E10.4))') (ESW(RTT+10.*I),I=-4,4) WRITE(UNIT=KULOUT,FMT='(10(1X,E10.4))') (ESS(RTT+10.*I),I=-4,4) WRITE(UNIT=KULOUT,FMT='(10(1X,E10.4))') (ES (RTT+10.*I),I=-4,4) C C ------------------------------------------------------------------ C RETURN END