#!/bin/sh
#--------
#------------------------------------------------------
# PROCEDURE DE CALCUL DES PROFILS ET DES FORCAGES
# POUR LE CAS BOMEX
#------------------------------------------------------
# Il faut se donner NFLEV, et le fichier "VAH, VBH"
#------------------------------------------------------
#===========
  NLEV=19  # 19, 31, 75
#===========
 NAME=_bomex
#===========
#----------------------------------------------------
# types de fichiers "vah_vbh_L$NLEV$NAME" prevus :
#----------------------------------------------------
# L19_bomex ; L31_bomex  ; L75_bomex
#             L31_arpege
#
#--------------------
# controles divers :
#--------------------
#
if [ $NLEV -lt 10 ] || [ $NLEV -gt 98 ] ; then
  echo " NLEV trop grand (entre 10 et 98) "$NLEV
  exit
fi
#
if  [ -s vah_vbh_L$NLEV$NAME ] ; then
    echo " OK pour (vah_vbh) "
else
    echo " fichier (vah_vbh) absent ! : "vah_vbh_L$NLEV$NAME
    exit
fi
#
#--------------------
# Debut du FORTRAN :
#--------------------
cat <<EOF>vah_vbh_L19_bomex
!==============================
!  La coordonee verticale L19 :
!==============================
    data VAH/ &
 &    1311.048096     , &
 &    1226.363403     , &
 &    1137.496460     , &
 &    1045.493042     , &
 &    951.3986820     , &
 &    856.2587280     , &
 &    761.1188960     , &
 &    667.0245360     , &
 &    575.0211180     , &
 &    486.1542660     , &
 &    401.4693600     , &
 &    322.0118410     , &
 &    248.8273470     , &
 &    182.9612580     , &
 &    125.4591600     , &
 &    77.36650100     , &
 &    39.72872900     , &
 &    13.59141300     , &
 &   0.0000000000     , &
 &   0.0000000000 /  
    data VBH/ &
 &   0.5334702730     , &
 &   0.5697643161     , &
 &   0.6057290435     , &
 &   0.6411924958     , &
 &   0.6759824157     , &
 &   0.7099269032     , &
 &   0.7428537607     , &
 &   0.7745908499     , &
 &   0.8049662113     , &
 &   0.8338077664     , &
 &   0.8609431386     , &
 &   0.8862006068     , &
 &   0.9094079137     , &
 &   0.9303930998     , &
 &   0.9489839077     , &
 &   0.9650081992     , &
 &   0.9782941937     , &
 &   0.9886693358     , &
 &   0.9959621429     , &
 &    1.000000000 /
EOF
cat <<EOF>vah_vbh_L31_bomex
!================================
!  La coordonee verticale L31 : (ECMWF ? ; sur le site BOMEX)
!================================
    data VAH/ &
      &   1000.0000000000, &
      &   2000.0000000000, &
      &   4000.0000000000, &
      &   6000.0000000000, &
      &   8000.0000000000, &
      &   9976.1353610000, &
      &  11820.5396170000, &
      &  13431.3939260000, &
      &  14736.3569090000, &
      &  15689.2074580000, &
      &  16266.6105000000, &
      &  16465.0057340000, &
      &  16297.6193320000, &
      &  15791.5986040000, &
      &  14985.2696300000, &
      &  13925.5178580000, &
      &  12665.2916620000, &
      &  11261.2288780000, &
      &   9771.4062900000, &
      &   8253.2120960000, &
      &   6761.3413260000, &
      &   5345.9142400000, &
      &   4050.7176780000, &
      &   2911.5693850000, &
      &   1954.8052960000, &
      &   1195.8897910000, &
      &    638.1489110000, &
      &    271.6265450000, &
      &     72.0635770000, &
      &      0.0000000000, &
      &      0.0000000000, &
      &      0.0000000000 /
    data VBH/ &
       &   0.0000000000, &
       &   0.0000000000, &
       &   0.0000000000, &
       &   0.0000000000, &
       &   0.0000000000, &
       &   0.0003908582, &
       &   0.0029197006, &
       &   0.0091941320, &
       &   0.0203191555, &
       &   0.0369748598, &
       &   0.0594876397, &
       &   0.0878949492, &
       &   0.1220035886, &
       &   0.1614415235, &
       &   0.2057032385, &
       &   0.2541886223, &
       &   0.3062353873, &
       &   0.3611450218, &
       &   0.4182022749, &
       &   0.4766881754, &
       &   0.5358865832, &
       &   0.5950842740, &
       &   0.6535645569, &
       &   0.7105944258, &
       &   0.7654052430, &
       &   0.8171669567, &
       &   0.8649558510, &
       &   0.9077158297, &
       &   0.9442132326, &
       &   0.9729851852, &
       &   0.9922814815, &
       &   1.0000000000 /
EOF
cat <<EOF>vah_vbh_L31_arpege
!================================
!  La coordonee verticale L31 : (ARPEGE)
!================================
    data VAH/ &
 &  2000.0000000,4000.0000000,6000.0000000, &
 &  8000.0000000,9976.1367188,11820.5390625, &
 &  13431.3945313,14736.3554688,15689.2070313, &
 &  16266.6093750,16465.0039063,16297.6210938, &
 &  15791.5976563,14985.2695313,13925.5195313, &
 &  12665.2929688,11261.2304688,9771.4062500, &
 &  8253.2109375,6761.3398438,5345.9140625, &
 &  4050.7177734,2911.5693359,1954.8051758, &
 &  1195.8898926,638.1489258,271.6264648, &
 &  72.0635834,0.0000000,0.0000000,0.0000000 /
    data VBH/ &
 &  0.0000000,0.0000000,0.0000000,0.0000000, &
 &  .0003909,.0029197,.0091941,.0203192, &
 &  .0369749,.0594876,.0878950,.1220036, &
 &  .1614415,.2057033,.2541886,.3062354, &
 &  .3611450,.4182023,.4766881,.5358866, &
 &  .5950842,.6535646,.7105944,.7654052, &
 &  .8171670,.8649558,.9077159,.9442132, &
 &  .9729852,.9922815,1.0000000 /
EOF
cat <<EOF>vah_vbh_L75_bomex
!================================
!  La coordonee verticale L75 : (dz=40m ; sur le site BOMEX)
!================================
    data VAH/ &
   &    71647.98, &
   &    71993.60, &
   &    72340.56, &
   &    72688.87, &
   &    73038.53, &
   &    73389.53, &
   &    73741.90, &
   &    74095.63, &
   &    74450.72, &
   &    74807.18, &
   &    75165.02, &
   &    75524.23, &
   &    75884.82, &
   &    76246.81, &
   &    76610.20, &
   &    76974.96, &
   &    77341.12, &
   &    77708.70, &
   &    78077.70, &
   &    78448.09, &
   &    78819.89, &
   &    79193.13, &
   &    79567.80, &
   &    79943.88, &
   &    80321.39, &
   &    80700.41, &
   &    81081.08, &
   &    81463.48, &
   &    81847.59, &
   &    82233.46, &
   &    82621.05, &
   &    83010.41, &
   &    83401.54, &
   &    83794.42, &
   &    84189.09, &
   &    84585.54, &
   &    84983.80, &
   &    85383.85, &
   &    85785.66, &
   &    86189.03, &
   &    86593.91, &
   &    87000.30, &
   &    87408.20, &
   &    87817.62, &
   &    88228.54, &
   &    88641.00, &
   &    89054.99, &
   &    89470.50, &
   &    89887.56, &
   &    90306.16, &
   &    90726.32, &
   &    91148.02, &
   &    91571.27, &
   &    91996.09, &
   &    92422.48, &
   &    92850.43, &
   &    93279.96, &
   &    93711.06, &
   &    94143.77, &
   &    94578.03, &
   &    95013.89, &
   &    95451.36, &
   &    95890.38, &
   &    96330.87, &
   &    96772.80, &
   &    97216.16, &
   &    97660.96, &
   &    98107.19, &
   &    98554.85, &
   &    99003.97, &
   &    99454.52, &
   &    99906.54, &
   &   100359.99, &
   &   100814.89, &
   &   101271.27, &
   &   101500.00 /
    data VBH/ &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00, &
   &        0.00 /
EOF
cat <<EOF>prog.f90
    program BOMEX

    integer    NFLEV
    parameter (NFLEV=$NLEV, KFLEV=$NLEV)

!   THE HALF LEVEL PRESSURE IS: P_half=VAH+VBH*P_surf

    real VAH  (0:NFLEV), VBH  (0:NFLEV),   VALH(0:NFLEV)
    real VETAH(0:NFLEV), VETAF(0:NFLEV+1), VP00 
    real VC   (1:NFLEV), VDELB(1:NFLEV)

    real PHIH(0:NFLEV), PRESH(0:NFLEV)

    real PHIF(1:NFLEV), PRESF(1:NFLEV) 

    real PR  (1:NFLEV),PT  (1:NFLEV),PQ  (1:NFLEV)
    real PU  (1:NFLEV),PV  (1:NFLEV),PCP (1:NFLEV)
    real PUG (1:NFLEV),PVG (1:NFLEV),PTKE(1:NFLEV)
    real PKAP(1:NFLEV),PW  (1:NFLEV)
    real PFT (1:NFLEV),PFQ (1:NFLEV)

    REAL PDELP (KFLEV),PRDELP(KFLEV)
    REAL PLNPR (KFLEV),PALPH (KFLEV)
    REAL PRTGR (KFLEV)
    REAL PRPRES(KFLEV),PRPP  (KFLEV)

    logical LAPRXPK

    character CL2*2, CL5*5, CL15*15, CL22*22

!==============================
!  Partie issue de "fcttrm.h" :
!==============================
REAL PTARG
RLV(PTARG)=RLVTT+(RCPV-RCW)*(PTARG-RTT)
RLS(PTARG)=RLSTT+(RCPV-RCS)*(PTARG-RTT)
RLF(PTARG)=RLS(PTARG)-RLV(PTARG)
ESW(PTARG)=EXP(RALPW-RBETW/PTARG-RGAMW*LOG(PTARG))
ESS(PTARG)=EXP(RALPS-RBETS/PTARG-RGAMS*LOG(PTARG))
ES (PTARG)=EXP(&
          &(RALPW+RALPD*MAX(0.0,SIGN(1.0,RTT-PTARG)))&
         &-(RBETW+RBETD*MAX(0.0,SIGN(1.0,RTT-PTARG)))/PTARG &
         &-(RGAMW+RGAMD*MAX(0.0,SIGN(1.0,RTT-PTARG)))*LOG(PTARG))
REAL, FOEW, PDELARG
FOEW ( PTARG,PDELARG ) = EXP (&
    &( RALPW+PDELARG*RALPD )&
  &- ( RBETW+PDELARG*RBETD ) / PTARG &
  &- ( RGAMW+PDELARG*RGAMD ) * LOG(PTARG) )
REAL, FODLEW
FODLEW ( PTARG,PDELARG ) = (&
      &( RBETW+PDELARG*RBETD )&
    &- ( RGAMW+PDELARG*RGAMD ) * PTARG )&
    &/ ( PTARG*PTARG )
REAL FOQS, PESPFAR
FOQS ( PESPFAR ) = PESPFAR / ( 1.0+RETV*MAX(0.0,&
    &(1.0-PESPFAR)) )
REAL FODQS, PQSFARG, PDLEFAR 
FODQS ( PQSFARG,PESPFAR,PDLEFAR ) = ( PQSFARG &
   &* (1.0-PQSFARG)*PDLEFAR ) / (1.0-PESPFAR)
REAL FOLH
FOLH ( PTARG,PDELARG ) =  RV * (&
    &( RBETW+PDELARG*RBETD )&
  &- ( RGAMW+PDELARG*RGAMD ) * PTARG )
EOF
######################################
#------------------------
# suite (1) du FORTRAN :
#------------------------
 cat  vah_vbh_L$NLEV$NAME>>prog.f90
#
######################################
#------------------------
# suite (2) du FORTRAN :
#------------------------
cat <<EOF>>prog.f90
!-----------------------------------------------------------------------
!
nulout=6
kulout=6
!
!  ==================
!     NDLNPR=0 : 0=CONVENTIONAL FORMULATION OF DELTA, I.E. LN(P(L)/P(L-1)).
!              : 1=FORMULATION OF DELTA USED IN NON HYDROSTATIC MODEL,
!     LAPRXPK  : the way of computing full-levels pressures
!     ZPSOL    : valeur de la pression au sol
!     ZOROG    : valeur de la hauteur  du sol
!  ==================
      NDLNPR=0
      LAPRXPK =.FALSE.
      ZPSOL=101500.
      ZOROG=0.0
!  ==================

!=============================
!  Partie issue de "sucst" :
!=============================

!     DEFINE FUNDAMENTAL CONSTANTS.
!     -----------------------------
      RPI=2.0*ASIN(1.0)
      RCLUM=299792458.
      RHPLA=6.6260755E-34
      RKBOL=1.380658E-23
      RNAVO=6.0221367E+23

!     DEFINE ASTRONOMICAL CONSTANTS.
!     ------------------------------
      RDAY=86400.
      REA=149597870000.
      REPSM=0.409093

      RSIYEA=365.25*RDAY*2.0*RPI/6.283076
      RSIDAY=RDAY/(1.0+RDAY/RSIYEA)
      ROMEGA=2.0*RPI/RSIDAY

!     DEFINE GEOIDE.
!     --------------
      RG=9.80665
      RA=6371229.
      R1SA=1.0/RA

!     DEFINE RADIATION CONSTANTS.
!     ---------------------------
      RSIGMA=2.0 * RPI**5 * RKBOL**4 /(15.* RCLUM**2 * RHPLA**3)
      RI0=1370.

!     DEFINE THERMODYNAMIC CONSTANTS, GAS PHASE.
!     ------------------------------------------
      R=RNAVO*RKBOL

      RMD=28.9644
      RMV=18.0153
      RMO3=47.9942

      RD=287.06     ! La constante des gaz parfaits         (dry air)
      RCVD=717.65   ! La chaleur specifique a "v" constant  (dry air)
      RCPD=1004.71  ! La chaleur specifique a "p" constante (dry air)

      RV=461.525    ! La constante des gaz parfaits         (water vapour)
      RCVV=1384.6   ! La chaleur specifique a "v" constant  (water vapour)
      RCPV=1846.1   ! La chaleur specifique a "p" constante (water vapour)

      RKAPPA=RD/RCPD
      RETV=RV/RD-1.0

!     DEFINE THERMODYNAMIC CONSTANTS, LIQUID PHASE.
!     ---------------------------------------------
      RCW=4218.     ! La chaleur specifique   (liquid water)

!     DEFINE THERMODYNAMIC CONSTANTS, SOLID PHASE.
!     --------------------------------------------
      RCS=2106.     ! La chaleur specifique   (solid  water)

!     DEFINE THERMODYNAMIC CONSTANTS, TRANSITION OF PHASE.
!     ----------------------------------------------------
      RTT=273.16   ! La temperature au point triple de l'eau
      RDT=11.82
      RLVTT=2.5008E+6
      RLSTT=2.8345E+6
      RLVZER=RLVTT+RTT*(RCW-RCPV)
      RLSZER=RLSTT+RTT*(RCS-RCPV)
      RLMLT=RLSTT-RLVTT
      RATM=100000.      ! La pression standart pour la tempe. potentielle

!     SATURATED VAPOUR PRESSURE.
!     --------------------------
      RESTT=611.14
      RGAMW=(RCW-RCPV)/RV
      RBETW=RLVTT/RV+RGAMW*RTT
      RALPW=LOG(RESTT)+RBETW/RTT+RGAMW*LOG(RTT)
      RGAMS=(RCS-RCPV)/RV
      RBETS=RLSTT/RV+RGAMS*RTT
      RALPS=LOG(RESTT)+RBETS/RTT+RGAMS*LOG(RTT)
      RGAMD=RGAMS-RGAMW
      RBETD=RBETS-RBETW
      RALPD=RALPS-RALPW

IF (.TRUE.) THEN
  WRITE(KULOUT,'(''0*** Constants of the ICM   *** '')')
  WRITE(KULOUT,'('' *** Fundamental constants ***  '')')
  WRITE(KULOUT,'(''           PI = '',E13.7,'' -   '')')RPI
  WRITE(KULOUT,'(''            c = '',E13.7,''m s-1'')')RCLUM
  WRITE(KULOUT,'(''            h = '',E13.7,''J s  '')')RHPLA
  WRITE(KULOUT,'(''            K = '',E13.7,''J K-1'')')RKBOL
  WRITE(KULOUT,'(''            N = '',E13.7,''mol-1'')')RNAVO
  WRITE(KULOUT,'('' *** Astronomical constants *** '')')
  WRITE(KULOUT,'(''          day = '',E13.7,'' s   '')')RDAY
  WRITE(KULOUT,'('' half g. axis = '',E13.7,'' m   '')')REA
  WRITE(KULOUT,'('' mean anomaly = '',E13.7,'' -   '')')REPSM
  WRITE(KULOUT,'('' sideral year = '',E13.7,'' s   '')')RSIYEA
  WRITE(KULOUT,'(''  sideral day = '',E13.7,'' s   '')')RSIDAY
  WRITE(KULOUT,'(''        omega = '',E13.7,'' s-1 '')')ROMEGA
  WRITE(KULOUT,'('' ***         Geoide         ***'')')
  WRITE(KULOUT,'(''      Gravity = '',E13.7,'' m s-2'')')RG
  WRITE(KULOUT,'('' Earth radius = '',E13.7,'' m    '')')RA
  WRITE(KULOUT,'('' Inverse E.R. = '',E13.7,'' m    '')')R1SA
  WRITE(KULOUT,'('' ***        Radiation       ***  '')')
  WRITE(KULOUT,'('' Stefan-Bol.  = '',E13.7,'' W m-2 K-4'')')  RSIGMA
  WRITE(KULOUT,'('' Solar const. = '',E13.7,'' W m-2'')')RI0
  WRITE(KULOUT,'('' *** Thermodynamic, gas     ***'')')
  WRITE(KULOUT,'('' Perfect gas  = '',e13.7)') R
  WRITE(KULOUT,'('' Dry air mass = '',e13.7)') RMD
  WRITE(KULOUT,'('' Vapour  mass = '',e13.7)') RMV
  WRITE(KULOUT,'('' Ozone   mass = '',e13.7)') RMO3
  WRITE(KULOUT,'('' Dry air cst. = '',e13.7)') RD
  WRITE(KULOUT,'('' Vapour  cst. = '',e13.7)') RV
  WRITE(KULOUT,'(''         Cpd  = '',e13.7)') RCPD
  WRITE(KULOUT,'(''         Cvd  = '',e13.7)') RCVD
  WRITE(KULOUT,'(''         Cpv  = '',e13.7)') RCPV
  WRITE(KULOUT,'(''         Cvv  = '',e13.7)') RCVV
  WRITE(KULOUT,'(''      Rd/Cpd  = '',e13.7)') RKAPPA
  WRITE(KULOUT,'(''     Rv/Rd-1  = '',e13.7)') RETV
  WRITE(KULOUT,'('' *** Thermodynamic, liquid  ***'')')
  WRITE(KULOUT,'(''         Cw   = '',E13.7)') RCW
  WRITE(KULOUT,'('' *** thermodynamic, solid   ***'')')
  WRITE(KULOUT,'(''         Cs   = '',E13.7)') RCS
  WRITE(KULOUT,'('' *** Thermodynamic, trans.  ***'')')
  WRITE(KULOUT,'('' Fusion point = '',E13.7)') RTT
  WRITE(KULOUT,'('' RTT-Tx(ew-ei)= '',E13.7)') RDT
  WRITE(KULOUT,'(''        RLvTt = '',E13.7)') RLVTT
  WRITE(KULOUT,'(''        RLsTt = '',E13.7)') RLSTT
  WRITE(KULOUT,'(''        RLv0  = '',E13.7)') RLVZER
  WRITE(KULOUT,'(''        RLs0  = '',E13.7)') RLSZER
  WRITE(KULOUT,'(''        RLMlt = '',E13.7)') RLMLT
  WRITE(KULOUT,'('' Normal press.= '',E13.7)') RATM
  WRITE(KULOUT,'('' Latent heat :  '')')
  WRITE(KULOUT,'(10(1X,E10.4))') (10.*J,J=-4,4)
  WRITE(KULOUT,'(10(1X,E10.4))') (RLV(RTT+10.*J),J=-4,4)
  WRITE(KULOUT,'(10(1X,E10.4))') (RLS(RTT+10.*J),J=-4,4)
  WRITE(KULOUT,'('' *** Thermodynamic, satur.  ***'')')
  WRITE(KULOUT,'('' Fusion point = '',E13.7)') RTT
  WRITE(KULOUT,'(''      es(Tt)  = '',e13.7)') RESTT
  WRITE(KULOUT,'(''      es(T) :  '')')
  WRITE(KULOUT,'(10(1X,E10.4))') (10.*J,J=-4,4)
  WRITE(KULOUT,'(10(1X,E10.4))') (ESW(RTT+10.*J),J=-4,4)
  WRITE(KULOUT,'(10(1X,E10.4))') (ESS(RTT+10.*J),J=-4,4)
  WRITE(KULOUT,'(10(1X,E10.4))') (ES (RTT+10.*J),J=-4,4)
ENDIF


!=============================
!  Partie issue de "suvert" :
!=============================
!  INITIALISATION DU COMMON YOMGEM.
!  --------------------------------
      VP00=101325.
      DO JLEV=0,NFLEV
        VALH(JLEV)=VAH(JLEV)/VP00
      ENDDO
      VETAH(0)=VALH(0)+VBH(0)
      DO JLEV=1,NFLEV
        VETAH(JLEV)=VALH(JLEV)+VBH(JLEV)
        VETAF(JLEV)=0.5*(VETAH(JLEV)+VETAH(JLEV-1))
      ENDDO
      VETAF(0)=0.0
      VETAF(NFLEV+1)=1.0
      DO JLEV=1,NFLEV
        VC   (JLEV) = VAH(JLEV)*VBH(JLEV-1) - VAH(JLEV-1)*VBH(JLEV)
        VDELB(JLEV) = VBH(JLEV)-VBH(JLEV-1)
      ENDDO
      WRITE(*,*) ' '
        WRITE(*,FMT='(1X,A3,3(1X,A15,5x))')&
         &'LEV','VALH','VBH','VAH'
      DO JLEV=0,NFLEV
        WRITE(*,FMT='(1X,I3,3(1X,F20.10))')&
         &JLEV,VALH(JLEV),VBH(JLEV),VAH(JLEV)
      ENDDO


!=============================
!  Partie issue de "gpspv" :
!=============================
      PRESH(KFLEV)=ZPSOL
      
!=============================
!  Partie issue de "gppreh" :
!=============================
!  COMPUTES HALF LEVEL PRESSURES.
!  ------------------------------
      DO JLEV=0,KFLEV-1
          PRESH(JLEV)=VAH(JLEV)+VBH(JLEV)*PRESH(KFLEV)
      ENDDO
     
!=============================
!  Partie issue de "gpxyb" :
!=============================

      ZTOPPRES=0.1
      IF(PRESH(0) <= ZTOPPRES)THEN
        IFIRST=2
      ELSE
        IFIRST=1
      ENDIF

! - - - - - - - - - - -
  IF(NDLNPR == 0) THEN
! - - - - - - - - - - -

  DO JLEV=IFIRST,KFLEV
      PDELP (JLEV)=PRESH(JLEV)-PRESH(JLEV-1)
      PRDELP(JLEV)=1.0/PDELP(JLEV)
      PRPP  (JLEV)=1.0/(PRESH(JLEV)*PRESH(JLEV-1))
      PLNPR (JLEV)=LOG(PRESH(JLEV)/PRESH(JLEV-1))
      PALPH (JLEV)=1.0-PRESH(JLEV-1)*PRDELP(JLEV)*PLNPR(JLEV)
      PRTGR (JLEV)=PRDELP(JLEV)&
       &*(VDELB(JLEV)+VC(JLEV)*PLNPR(JLEV)*PRDELP(JLEV))
      PRPRES(JLEV)=1.0/PRESH(JLEV)
  ENDDO

  DO JLEV=1,IFIRST-1
      PDELP (JLEV)=PRESH(JLEV)-PRESH(JLEV-1)
      PRDELP(JLEV)=1.0/PDELP(JLEV)
      PLNPR (JLEV)=LOG(PRESH(1)/ZTOPPRES)
      PALPH (JLEV)=RHYDR0
      PRTGR (JLEV)=PRDELP(JLEV)*VDELB(JLEV)
      PRPRES(JLEV)=1.0/PRESH(1)
      PRPP  (JLEV)=1.0/(PRESH(1)*ZTOPPRES)
  ENDDO

! - - - - - - - - - - - - - -
  ELSEIF (NDLNPR == 1) THEN
! - - - - - - - - - - - - - -

  DO JLEV=IFIRST,KFLEV
      PDELP (JLEV)=PRESH(JLEV)-PRESH(JLEV-1)
      PRDELP(JLEV)=1.0/PDELP(JLEV)
      PRPP  (JLEV)=1.0/(PRESH(JLEV)*PRESH(JLEV-1))
      PLNPR (JLEV)=PDELP(JLEV)*SQRT(PRPP(JLEV))
      PALPH (JLEV)=1.0-PRESH(JLEV-1)*PRDELP(JLEV)*PLNPR(JLEV)
      PRTGR (JLEV)=PRDELP(JLEV)&
       &*(VDELB(JLEV)+VC(JLEV)*PLNPR(JLEV)*PRDELP(JLEV))
      PRPRES(JLEV)=1.0/PRESH(JLEV)
  ENDDO

  DO JLEV=1,IFIRST-1
      PDELP (JLEV)=PRESH(JLEV)
      PRDELP(JLEV)=1.0/PDELP(JLEV)
      PLNPR (JLEV)=2.0+RCVD/RD
      PALPH (JLEV)=1.0
      PRTGR (JLEV)=PRDELP(JLEV)*VDELB(JLEV)
      PRPRES(JLEV)=1.0/PRESH(1)
      PRPP  (JLEV)=(PLNPR(JLEV)*PRDELP(JLEV))**2
  ENDDO

! - - - -
  ENDIF
! - - - -
     
!=============================
!  Partie issue de "gppref" :
!=============================

IF (NDLNPR == 1) THEN
  ZTOPPRES=0.1
  IF(PRESH(0) <= ZTOPPRES)THEN
    IFIRST=2
  ELSE
    IFIRST=1
  ENDIF
ENDIF

IF (.NOT.LAPRXPK) THEN
  IF (NDLNPR == 0) THEN
    DO JLEV=1,KFLEV
        PRESF(JLEV)=EXP(-PALPH(JLEV))*PRESH(JLEV)
    ENDDO
  ELSEIF (NDLNPR == 1) THEN
    DO JLEV=IFIRST,KFLEV
        PRESF(JLEV)=(1.0-PALPH(JLEV))*PRESH(JLEV)
    ENDDO
    ZMUL=1.0/(2.0+RCVD/RD)
    DO JLEV=1,IFIRST-1
        PRESF(JLEV)=PRESH(JLEV)*ZMUL
    ENDDO
  ENDIF
ELSE
  DO JLEV=1,KFLEV
      PRESF(JLEV)=(PRESH(JLEV-1)+PRESH(JLEV))*0.5
  ENDDO
ENDIF
     

! Ensuite, dans "cpg" : GPRCP ; GPRT ; GPGRP


  print*,'  '
  print*,' ====================================='
  print*,'   Programme de calcul pour BOMEX'
  print*,' ====================================='
  print*,'  '


!- - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Calcul iteratif du couple "geopotentiel"/"temperature"
! En effet, on donne T=T(z), mais "z" dpend de T....
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
 nbiter=10
!
! Un premier "guess" pour "phih" et "phif" (avec R=RD et T=290K):
!
PHIH(KFLEV)=ZOROG
DO JLEV=KFLEV,1,-1
    PR  (JLEV)  =RD
    PT  (JLEV)  =290.
    PHIH(JLEV-1)=PHIH(JLEV)+PR(JLEV)*PT(JLEV)*PLNPR(JLEV)
    PHIF(JLEV)  =PHIH(JLEV)+PALPH(JLEV)*PR(JLEV)*PT(JLEV)
ENDDO

  write(*,*) ' '
!=======================
    do jiter=1,nbiter
!=======================
  write(*,'(1x,a6,1x,i3 )') 'ITER=',jiter

  !- - - - - - - - - -
  ! Values for T(z) : (en : K)
  !- - - - - - - - - -
  DO JLEV = 1,KFLEV
    zzz=PHIF(JLEV)/RG
    if (zzz.le.520.) then
       zval = 298.7
    elseif ((zzz.gt.520.).and.(zzz.le.1480.)) then
       zval = 298.7 + (302.4-298.7)*(zzz-520.)/(1480.-520.)
    elseif ((zzz.gt.1480.).and.(zzz.le.2000.)) then
       zval = 302.4 + (308.2-302.4)*(zzz-1480.)/(2000.-1480.)
    elseif ((zzz.gt.2000.).and.(zzz.le.12000.)) then
       zval = 308.2  + 3.65e-3 *(zzz-2000.)
    else
       zval = 344.7  + 35.e-3  *(zzz-12000.)
    endif
    PT(JLEV)=zval/(RATM/PRESF(JLEV))**RKAPPA
  ENDDO

  !- - - - - - - - - - -
  ! Values for q_v(z) : (en : kg/kg)
  !- - - - - - - - - - -
  DO JLEV = 1,KFLEV
    zzz=PHIF(JLEV)/RG
    if (zzz.le.520.) then
       zval = 17. + (16.3-17.0)/520.*zzz
    elseif ((zzz.gt.520.).and.(zzz.le.1480.)) then
       zval = 16.3 + (10.7-16.3)/(1480.-520.)*(zzz-520.)
    elseif ((zzz.gt.1480.).and.(zzz.le.2000.)) then
       zval = 10.7 + (4.2-10.7)/(2000.-1480.)*(zzz-1480.)
    else
       zval = 4.2- 1.2e-3 *(zzz-2000.)
    endif
    PQ(JLEV)=max(zval,0.0001)/1000.
  ENDDO

  !=============================
  !  Partie issue de "gprcp" :
  !=============================
  !  Computes moist Cp, R and Kappa=R/Cp from Qv.
  !  --------------------------------------------
  DO JLEV=1,KFLEV
    PR  (JLEV) =   RD*(1.0-PQ(JLEV))+ RV *PQ(JLEV)
    PCP (JLEV) = RCPD*(1.0-PQ(JLEV))+RCPV*PQ(JLEV)
    PKAP(JLEV) = PR(JLEV)/PCP(JLEV)
  ENDDO

  !=============================
  !  Partie issue de "gpgeo" :
  !=============================
  !  COMPUTES HALF AND FULL LEVEL GEOPOTENTIAL.
  !  ------------------------------------------
  PHIH(KFLEV)=ZOROG
  DO JLEV=KFLEV,1,-1
    PHIH(JLEV-1)=PHIH(JLEV)+PR(JLEV)*PT(JLEV)*PLNPR(JLEV)
    PHIF(JLEV)  =PHIH(JLEV)+PALPH(JLEV)*PR(JLEV)*PT(JLEV)
  ENDDO

!============
    enddo
!============
  write(*,*) ' '


  !- - - - - - - - - - -
  ! Values for u(z) : (en m/s)
  !- - - - - - - - - - -
  DO JLEV = 1,KFLEV
    zzz=PHIF(JLEV)/RG
    if (zzz.le.700.) then
       zval = -8.75
    else
       zval = -8.75 + 1.8e-3 *(zzz-700.)
    endif
    PU(JLEV)=min(0.0, zval)
  ENDDO

  !- - - - - - - - - - -
  ! Values for v(z) : (en m/s)
  !- - - - - - - - - - -
  DO JLEV = 1,KFLEV
    zzz=PHIF(JLEV)/RG
    zval = 0.0
    PV(JLEV)=zval
  ENDDO

  !- - - - - - - - - - -
  ! Values for u_g(z) : (en m/s)
  !- - - - - - - - - - -
  DO JLEV = 1,KFLEV
    zzz=PHIF(JLEV)/RG
    zval = -10. + 1.8e-3*zzz
    PUG(JLEV)=min(0.0, zval)
  ENDDO

  !- - - - - - - - - - -
  ! Values for v_g(z) : (en m/s)
  !- - - - - - - - - - -
  DO JLEV = 1,KFLEV
    zval = 0.0
    PVG(JLEV)=zval
  ENDDO

  !- - - - - - - - - - -
  ! Values for w(z) : (en m/s)
  !- - - - - - - - - - -
  DO JLEV = 1,KFLEV
    zzz=PHIF(JLEV)/RG
    if (zzz.le.1500.) then
       zval = - (0.0065/1500.)*zzz
    elseif ((zzz.gt.1500.).and.(zzz.le.2100.)) then
       zval = - 0.0065 + 0.0065/(2100.-1500.)*(zzz-1500.)
    else
       zval = 0.0
    endif
    PW(JLEV)=zval
  ENDDO

  !- - - - - - - - - - - -
  ! Values for dT/dt(z) : (en K/s)
  !- - - - - - - - - - - -
  DO JLEV = 1,KFLEV
    zzz=PHIF(JLEV)/RG
    if (zzz.le.1500.) then
       zval = - 2.315e-5
    elseif ((zzz.gt.1500.).and.(zzz.le.2500.)) then
       zval = - 2.315e-5 + 2.315e-5/(2500.-1500.)*(zzz-1500.)
    else
       zval = 0.0
    endif
    PFT(JLEV)=zval/(RATM/PRESF(JLEV))**RKAPPA
  ENDDO

  !- - - - - - - - - - - - -
  ! Values for dq_v/dt(z) : (en (kg/kg)/s)
  !- - - - - - - - - - - - -
  DO JLEV = 1,KFLEV
    zzz=PHIF(JLEV)/RG
    if (zzz.le.300.) then
       zval = - 1.2e-8
    elseif ((zzz.gt.300.).and.(zzz.le.500.)) then
       zval = - 1.2e-8 + 1.2e-8/(500.-300.)*(zzz-300.)
    else
       zval = 0.0
    endif
    PFQ(JLEV)=zval
  ENDDO

  !- - - - - - - - - - - - -
  ! Values for TKE(z) : (en m^2/s^2)
  !- - - - - - - - - - - - -
  DO JLEV = 1,KFLEV
    zzz=PHIF(JLEV)/RG
    if (zzz.le.3000.) then
       zval = 1.0 - zzz/3000.
    else
       zval = 0.0
    endif
    PTKE(JLEV)=zval
  ENDDO

!=======================
! The final printing :
!=======================
!
  if (.TRUE.) then
  write(*,'( 2x,A3, 7(3x,A5,3x)') 'lev', 'Pre_h', 'Pre_f', &
                                    & 'Alt_h', 'Alt_f', &
                                    & 'Tempe', 'Theta', 'Q_vap'
  write(*,'( 1x,i3,        1x,F10.5, 11x, 1x,F10.2)') &
       &  0,            presh(0)/100.,    phih(0)/RG
  do jlev=1,nflev
  write(*,'( 1x,i3,   11x, 1x,F10.5, 11x, 1x,F10.2, 4(1x,F10.4))') &
       &      jlev,     presf(jlev)/100., phif(jlev)/RG, &
       &  pt(jlev), pt(jlev)*(RATM/PRESF(JLEV))**RKAPPA, &
       &  pq(jlev)*1000.
  write(*,'( 1x,i3,        1x,F10.5, 11x, 1x,F10.2)') &
       &      jlev,     presh(jlev)/100., phih(jlev)/RG
  enddo
  write(*,'( 2x,A3, 7(3x,A5,3x)') 'lev', 'Pre_h', 'Pre_f', &
                                    & 'Alt_h', 'Alt_f', &
                                    & 'Tempe', 'Theta', 'Q_vap'
  endif
!
  if (.TRUE.) then
  write(*,*) ' '
  write(*,'( 2x,A3, 4(3x,A5,3x)') 'lev', 'Pre_f', 'Alt_f', &
                                       & '  u  ', ' u_g '
  do jlev=1,nflev
  write(*,'( 1x,i3,   1x,F10.5, 1x,F10.2, 2(1x,F10.4))') &
       &      jlev,     presf(jlev)/100., phif(jlev)/RG, &
       &                pu(jlev),         pug(jlev)
  enddo
  write(*,'( 2x,A3, 4(3x,A5,3x)') 'lev', 'Pre_f', 'Alt_f', &
                                       & '  u  ', ' u_g '
  endif
!
!===========================
! Printing for *LFA* files:
!===========================

  CL15='R8-%%!!R       '

  !- - - - - - - - - -
  ! Print for VAH :
  !- - - - - - - - - -
  CL5='VAH  '
  write(*,*) ' '
  write(CL22,'(A15,I2,A5)') CL15,KFLEV+1,CL5
  write(*,'(A22)') CL22
  DO JLEV = 0,KFLEV
    write(*,'( 1X,E16.9 )') VAH(JLEV)
  ENDDO

  !- - - - - - - - - -
  ! Print for VBH :
  !- - - - - - - - - -
  CL5='VBH  '
  write(*,*) ' '
  write(CL22,'(A15,I2,A5)') CL15,KFLEV+1,CL5
  write(*,'(A22)') CL22
  DO JLEV = 0,KFLEV
    write(*,'( 1X,E16.9 )') VBH(JLEV)
  ENDDO

  !- - - - - - - - - -
  ! Print for T(z) : (en : K)
  !- - - - - - - - - -
  CL5='PTT0 '
  write(*,*) ' '
  write(CL22,'(A15,I2,A5)') CL15,KFLEV,CL5
  write(*,'(A22)') CL22
  DO JLEV = 1,KFLEV
    write(*,'( 1X,E16.9 )') PT(JLEV)
  ENDDO

  !- - - - - - - - - - -
  ! Print for q_v(z) : (en : kg/kg)
  !- - - - - - - - - - -
  CL5='PQT0 '
  write(*,*) ' '
  write(CL22,'(A15,I2,A5)') CL15,KFLEV,CL5
  write(*,'(A22)') CL22
  DO JLEV = 1,KFLEV
    write(*,'( 1X,E16.9 )') PQ(JLEV)
  ENDDO

  !- - - - - - - - - - -
  ! Print for u(z) : (en : m/s)
  !- - - - - - - - - - -
  CL5='PUT0 '
  write(*,*) ' '
  write(CL22,'(A15,I2,A5)') CL15,KFLEV,CL5
  write(*,'(A22)') CL22
  DO JLEV = 1,KFLEV
    write(*,'( 1X,E16.9 )') PU(JLEV)
  ENDDO

  !- - - - - - - - - - -
  ! Print for v(z) : (en : m/s)
  !- - - - - - - - - - -
  CL5='PVT0 '
  write(*,*) ' '
  write(CL22,'(A15,I2,A5)') CL15,KFLEV,CL5
  write(*,'(A22)') CL22
  DO JLEV = 1,KFLEV
    write(*,'( 1X,E16.9 )') PV(JLEV)
  ENDDO

  !- - - - - - - - - - -
  ! Print for ug(z) : (en : m/s)
  !- - - - - - - - - - -
  CL5='PFUG '
  write(*,*) ' '
  write(CL22,'(A15,I2,A5)') CL15,KFLEV,CL5
  write(*,'(A22)') CL22
  DO JLEV = 1,KFLEV
    write(*,'( 1X,E16.9 )') PUG(JLEV)
  ENDDO

  !- - - - - - - - - - -
  ! Print for vg(z) : (en : m/s)
  !- - - - - - - - - - -
  CL5='PFVG '
  write(*,*) ' '
  write(CL22,'(A15,I2,A5)') CL15,KFLEV,CL5
  write(*,'(A22)') CL22
  DO JLEV = 1,KFLEV
    write(*,'( 1X,E16.9 )') PVG(JLEV)
  ENDDO

  !- - - - - - - - - - -
  ! Print for w(z) : (en : m/s)
  !- - - - - - - - - - -
  CL5='DYN-W'
  write(*,*) ' '
  write(CL22,'(A15,I2,A5)') CL15,KFLEV,CL5
  write(*,'(A22)') CL22
  DO JLEV = 1,KFLEV
    write(*,'( 1X,E16.9 )') PW(JLEV)
  ENDDO

  !- - - - - - - - - - -
  ! Print for dT/dt(z) : (en K/s)
  !- - - - - - - - - - -
  CL5='DYN-T'
  write(*,*) ' '
  write(CL22,'(A15,I2,A5)') CL15,KFLEV,CL5
  write(*,'(A22)') CL22
  DO JLEV = 1,KFLEV
    write(*,'( 1X,E16.9 )') PFT(JLEV)
  ENDDO

  !- - - - - - - - - - - -
  ! Print for dq_v/dt(z) : (en (kg/kg)/s)
  !- - - - - - - - - - - -
  CL5='DYN-Q'
  write(*,*) ' '
  write(CL22,'(A15,I2,A5)') CL15,KFLEV,CL5
  write(*,'(A22)') CL22
  DO JLEV = 1,KFLEV
    write(*,'( 1X,E16.9 )') PFQ(JLEV)
  ENDDO

  !- - - - - - - - - - - - -
  ! Values for TKE(z) : (en m^2/s^2)
  !- - - - - - - - - - - - -
  CL5='PAT0 '
  write(*,*) ' '
  write(CL22,'(A15,I2,A5)') CL15,KFLEV,CL5
  write(*,'(A22)') CL22
  DO JLEV = 1,KFLEV
    write(*,'( 1X,E16.9 )') PTKE(JLEV)
  ENDDO




  CL5='PTS0 '
  ZTS0=300.375
  write(*,*) ' '
  write(CL22,'(A15,A2,A5)') CL15,' 1',CL5
  write(*,'(A22)') CL22
  write(*,'( 1X,E16.6 )') ZTS0

  CL5='PQS0 '
  ZQS0=0.02245
  write(*,*) ' '
  write(CL22,'(A15,A2,A5)') CL15,' 1',CL5
  write(*,'(A22)') CL22
  write(*,'( 1X,E16.6 )') ZQS0

  CL5='PSPT0'
  ZPS0=101500.
  write(*,*) ' '
  write(CL22,'(A15,A2,A5)') CL15,' 1',CL5
  write(*,'(A22)') CL22
  write(*,'( 1X,E16.6 )') LOG(ZPS0)




  ZRHO=PRESH(KFLEV)/RD/ZTS0
  ZFS=-8e-3*RCPD*ZRHO
  CL5='PFSH '
  write(*,*) ' '
  write(CL22,'(A15,A2,A5)') CL15,' 1',CL5
  write(*,'(A22)') CL22
  write(*,'( 1X,E16.6 )') ZFS

  ZDELTA=MAX(0.0,SIGN(1.0,RTT-ZTS0))
  ZRHO=PRESH(KFLEV)/RD/ZTS0
! print*,' pre= ',PRESH(KFLEV)
! print*,' Rd = ',RD
! print*,' Ts = ',ZTS0
! print*,' rho= ',ZRHO
! print*,' Lv = ',FOLH(ZTS0,ZDELTA)
  ZFL=-5.2e-5*FOLH(ZTS0,ZDELTA)*ZRHO
  CL5='PFLH '
  write(*,*) ' '
  write(CL22,'(A15,A2,A5)') CL15,' 1',CL5
  write(*,'(A22)') CL22
  write(*,'( 1X,E16.6 )') ZFL

  ZFUSTAR=0.28
  CL5='PFUST'
  write(*,*) ' '
  write(CL22,'(A15,A2,A5)') CL15,' 1',CL5
  write(*,'(A22)') CL22
  write(*,'( 1X,E16.6 )') ZFUSTAR

  print*,'  '

  stop
  end 
EOF
yes | pgf90 prog.f90
chmod +x a.out
#- - - - - - - - -
/bin/rm -f ftn??
a.out
#- - - - - - - - -
/bin/rm -f prog* a.out
echo " "
