Ignore:
Timestamp:
Jul 24, 2024, 4:23:34 PM (11 months ago)
Author:
abarral
Message:

rename modules properly lmdz_*
move some unused files to obsolete/
(lint) uppercase fortran keywords

Location:
LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d
Files:
18 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/1D_decl_cases.h

    r5103 r5117  
    44!        integer nlev_prof
    55!        parameter (nlev_prof = 41)
    6         integer nlev_toga, nt_toga
     6        INTEGER nlev_toga, nt_toga
    77        parameter (nlev_toga=41, nt_toga=480)
    8         integer year_ini_toga, day_ini_toga, mth_ini_toga
    9         real day_ju_ini_toga   ! Julian day of toga coare first day
     8        INTEGER year_ini_toga, day_ini_toga, mth_ini_toga
     9        REAL day_ju_ini_toga   ! Julian day of toga coare first day
    1010        parameter (year_ini_toga=1992)
    1111        parameter (mth_ini_toga=11)
    1212        parameter (day_ini_toga=1)  !  1erNov1992
    13         real dt_toga
     13        REAL dt_toga
    1414        parameter (dt_toga=6.*3600.)
    1515!!
    16         integer year_print, month_print, day_print
     16        INTEGER year_print, month_print, day_print
    1717        real    sec_print
    1818!!
    19         real ts_toga(nt_toga)
    20         real plev_toga(nlev_toga,nt_toga),w_toga(nlev_toga,nt_toga)
    21         real t_toga(nlev_toga,nt_toga),q_toga(nlev_toga,nt_toga)
    22         real u_toga(nlev_toga,nt_toga),v_toga(nlev_toga,nt_toga)
    23         real ht_toga(nlev_toga,nt_toga),vt_toga(nlev_toga,nt_toga)
    24         real hq_toga(nlev_toga,nt_toga),vq_toga(nlev_toga,nt_toga)
    25 
    26         real ts_prof
    27         real plev_prof(nlev_toga),w_prof(nlev_toga)
    28         real t_prof(nlev_toga),q_prof(nlev_toga)
    29         real u_prof(nlev_toga),v_prof(nlev_toga)
    30         real ht_prof(nlev_toga),vt_prof(nlev_toga)
    31         real hq_prof(nlev_toga),vq_prof(nlev_toga)
    32 
    33         real w_mod(llm), t_mod(llm),q_mod(llm)
    34         real u_mod(llm),v_mod(llm), ht_mod(llm),vt_mod(llm),ug_mod(llm),vg_mod(llm)
     19        REAL ts_toga(nt_toga)
     20        REAL plev_toga(nlev_toga,nt_toga),w_toga(nlev_toga,nt_toga)
     21        REAL t_toga(nlev_toga,nt_toga),q_toga(nlev_toga,nt_toga)
     22        REAL u_toga(nlev_toga,nt_toga),v_toga(nlev_toga,nt_toga)
     23        REAL ht_toga(nlev_toga,nt_toga),vt_toga(nlev_toga,nt_toga)
     24        REAL hq_toga(nlev_toga,nt_toga),vq_toga(nlev_toga,nt_toga)
     25
     26        REAL ts_prof
     27        REAL plev_prof(nlev_toga),w_prof(nlev_toga)
     28        REAL t_prof(nlev_toga),q_prof(nlev_toga)
     29        REAL u_prof(nlev_toga),v_prof(nlev_toga)
     30        REAL ht_prof(nlev_toga),vt_prof(nlev_toga)
     31        REAL hq_prof(nlev_toga),vq_prof(nlev_toga)
     32
     33        REAL w_mod(llm), t_mod(llm),q_mod(llm)
     34        REAL u_mod(llm),v_mod(llm), ht_mod(llm),vt_mod(llm),ug_mod(llm),vg_mod(llm)
    3535            real temp_nudg_mod(llm),qv_nudg_mod(llm),u_nudg_mod(llm),v_nudg_mod(llm)       
    36         real hq_mod(llm),vq_mod(llm),qv_mod(llm),ql_mod(llm),qt_mod(llm)
    37         real th_mod(llm)
     36        REAL hq_mod(llm),vq_mod(llm),qv_mod(llm),ql_mod(llm),qt_mod(llm)
     37        REAL th_mod(llm)
    3838
    3939! EV comment these lines
    … …  
    4343! Declarations specifiques au cas RICO
    4444        character*80 :: fich_rico
    45         integer nlev_rico
     45        INTEGER nlev_rico
    4646
    4747        parameter (nlev_rico=81)
    48         real ts_rico,ps_rico
    49         real w_rico(llm)
    50         real t_rico(llm),q_rico(llm)
    51         real u_rico(llm),v_rico(llm)
    52         real dth_rico(llm)
    53         real dqh_rico(llm)
     48        REAL ts_rico,ps_rico
     49        REAL w_rico(llm)
     50        REAL t_rico(llm),q_rico(llm)
     51        REAL u_rico(llm),v_rico(llm)
     52        REAL dth_rico(llm)
     53        REAL dqh_rico(llm)
    5454!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    5555! Declarations specifiques au cas TWPice
    5656        character*80 :: fich_twpice
    57         integer nlev_twpi, nt_twpi
     57        INTEGER nlev_twpi, nt_twpi
    5858        parameter (nlev_twpi=40, nt_twpi=215)
    59         integer year_ini_twpi, day_ini_twpi, mth_ini_twpi
    60         real heure_ini_twpi
    61         real day_ju_ini_twpi   ! Julian day of twpice first day
     59        INTEGER year_ini_twpi, day_ini_twpi, mth_ini_twpi
     60        REAL heure_ini_twpi
     61        REAL day_ju_ini_twpi   ! Julian day of twpice first day
    6262        parameter (year_ini_twpi=2006)
    6363        parameter (mth_ini_twpi=1)
    6464        parameter (day_ini_twpi=17)  ! 17 = 17Jan2006
    6565        parameter (heure_ini_twpi=10800.) !3h en secondes
    66         real dt_twpi
     66        REAL dt_twpi
    6767        parameter (dt_twpi=3.*3600.)
    6868
    69         real ts_twpi(nt_twpi)
    70         real plev_twpi(nlev_twpi,nt_twpi),w_twpi(nlev_twpi,nt_twpi)
    71         real t_twpi(nlev_twpi,nt_twpi),q_twpi(nlev_twpi,nt_twpi)
    72         real u_twpi(nlev_twpi,nt_twpi),v_twpi(nlev_twpi,nt_twpi)
    73         real ht_twpi(nlev_twpi,nt_twpi),vt_twpi(nlev_twpi,nt_twpi)
    74         real hq_twpi(nlev_twpi,nt_twpi),vq_twpi(nlev_twpi,nt_twpi)
    75 
    76         real ts_proftwp
    77         real plev_proftwp(nlev_twpi),w_proftwp(nlev_twpi)
    78         real t_proftwp(nlev_twpi),q_proftwp(nlev_twpi)
    79         real u_proftwp(nlev_twpi),v_proftwp(nlev_twpi)
    80         real ht_proftwp(nlev_twpi),vt_proftwp(nlev_twpi)
    81         real hq_proftwp(nlev_twpi),vq_proftwp(nlev_twpi)
     69        REAL ts_twpi(nt_twpi)
     70        REAL plev_twpi(nlev_twpi,nt_twpi),w_twpi(nlev_twpi,nt_twpi)
     71        REAL t_twpi(nlev_twpi,nt_twpi),q_twpi(nlev_twpi,nt_twpi)
     72        REAL u_twpi(nlev_twpi,nt_twpi),v_twpi(nlev_twpi,nt_twpi)
     73        REAL ht_twpi(nlev_twpi,nt_twpi),vt_twpi(nlev_twpi,nt_twpi)
     74        REAL hq_twpi(nlev_twpi,nt_twpi),vq_twpi(nlev_twpi,nt_twpi)
     75
     76        REAL ts_proftwp
     77        REAL plev_proftwp(nlev_twpi),w_proftwp(nlev_twpi)
     78        REAL t_proftwp(nlev_twpi),q_proftwp(nlev_twpi)
     79        REAL u_proftwp(nlev_twpi),v_proftwp(nlev_twpi)
     80        REAL ht_proftwp(nlev_twpi),vt_proftwp(nlev_twpi)
     81        REAL hq_proftwp(nlev_twpi),vq_proftwp(nlev_twpi)
    8282
    8383
    … …  
    8585!Declarations specifiques au cas FIRE
    8686        character*80 :: fich_fire
    87         integer nlev_fire, nt_fire
     87        INTEGER nlev_fire, nt_fire
    8888        parameter (nlev_fire=120, nt_fire=1) 
    89         integer year_ini_fire, day_ini_fire, mth_ini_fire
    90         real heure_ini_fire
     89        INTEGER year_ini_fire, day_ini_fire, mth_ini_fire
     90        REAL heure_ini_fire
    9191        parameter (year_ini_fire=1987)
    9292        parameter (mth_ini_fire=7)
    … …  
    133133!Declarations specifiques au cas DICE     (MPL 02072013)
    134134        character*80 :: fich_dice
    135         integer nlev_dice, nt_dice
     135        INTEGER nlev_dice, nt_dice
    136136        parameter (nlev_dice=70, nt_dice=145) 
    137         integer year_ini_dice, day_ini_dice, mth_ini_dice
    138         real heure_ini_dice
    139         real day_ju_ini_dice   ! Julian day of dice first day
     137        INTEGER year_ini_dice, day_ini_dice, mth_ini_dice
     138        REAL heure_ini_dice
     139        REAL day_ju_ini_dice   ! Julian day of dice first day
    140140        parameter (year_ini_dice=1999)
    141141        parameter (mth_ini_dice=10)
    142142        parameter (day_ini_dice=23)  ! 23 = 23 october 1999
    143143        parameter (heure_ini_dice=68400.) !19UTC en secondes
    144         real dt_dice
     144        REAL dt_dice
    145145        parameter (dt_dice=0.5*3600.) ! 1 forcage ttes les demi-heures
    146146
    147147!profils initiaux:
    148         real plev_dice(nlev_dice)
     148        REAL plev_dice(nlev_dice)
    149149       
    150         real zz_dice(nlev_dice)
    151         real t_dice(nlev_dice),qv_dice(nlev_dice)
    152         real u_dice(nlev_dice), v_dice(nlev_dice),o3_dice(nlev_dice)
    153         real ht_dice(nlev_dice,nt_dice)
    154         real hq_dice(nlev_dice,nt_dice), hu_dice(nlev_dice,nt_dice)
    155         real hv_dice(nlev_dice,nt_dice)
    156         real w_dice(nlev_dice,nt_dice),omega_dice(nlev_dice,nt_dice)
    157         real o3_mod(llm),hu_mod(llm),hv_mod(llm)
    158         real t_dicei(nlev_dice),qv_dicei(nlev_dice)
    159         real u_dicei(nlev_dice), v_dicei(nlev_dice),o3_dicei(nlev_dice)
    160         real ht_dicei(nlev_dice)
    161         real hq_dicei(nlev_dice), hu_dicei(nlev_dice)
    162         real hv_dicei(nlev_dice)
    163         real w_dicei(nlev_dice),omega_dicei(nlev_dice)
     150        REAL zz_dice(nlev_dice)
     151        REAL t_dice(nlev_dice),qv_dice(nlev_dice)
     152        REAL u_dice(nlev_dice), v_dice(nlev_dice),o3_dice(nlev_dice)
     153        REAL ht_dice(nlev_dice,nt_dice)
     154        REAL hq_dice(nlev_dice,nt_dice), hu_dice(nlev_dice,nt_dice)
     155        REAL hv_dice(nlev_dice,nt_dice)
     156        REAL w_dice(nlev_dice,nt_dice),omega_dice(nlev_dice,nt_dice)
     157        REAL o3_mod(llm),hu_mod(llm),hv_mod(llm)
     158        REAL t_dicei(nlev_dice),qv_dicei(nlev_dice)
     159        REAL u_dicei(nlev_dice), v_dicei(nlev_dice),o3_dicei(nlev_dice)
     160        REAL ht_dicei(nlev_dice)
     161        REAL hq_dicei(nlev_dice), hu_dicei(nlev_dice)
     162        REAL hv_dicei(nlev_dice)
     163        REAL w_dicei(nlev_dice),omega_dicei(nlev_dice)
    164164
    165165       
    166166!forcings
    167         real shf_dice(nt_dice),lhf_dice(nt_dice)
    168         real lwup_dice(nt_dice),swup_dice(nt_dice)
    169         real tg_dice(nt_dice),ustar_dice(nt_dice),psurf_dice(nt_dice)
    170         real ug_dice(nt_dice),vg_dice(nt_dice)
    171 
    172         real shf_prof,lhf_prof,lwup_prof,swup_prof,tg_prof
    173         real ustar_prof,psurf_prof,cdrag
    174         real ht_profd(nlev_dice),hq_profd(nlev_dice),hu_profd(nlev_dice)
    175         real hv_profd(nlev_dice),w_profd(nlev_dice)
    176         real omega_profd(nlev_dice),ug_profd,vg_profd
     167        REAL shf_dice(nt_dice),lhf_dice(nt_dice)
     168        REAL lwup_dice(nt_dice),swup_dice(nt_dice)
     169        REAL tg_dice(nt_dice),ustar_dice(nt_dice),psurf_dice(nt_dice)
     170        REAL ug_dice(nt_dice),vg_dice(nt_dice)
     171
     172        REAL shf_prof,lhf_prof,lwup_prof,swup_prof,tg_prof
     173        REAL ustar_prof,psurf_prof,cdrag
     174        REAL ht_profd(nlev_dice),hq_profd(nlev_dice),hu_profd(nlev_dice)
     175        REAL hv_profd(nlev_dice),w_profd(nlev_dice)
     176        REAL omega_profd(nlev_dice),ug_profd,vg_profd
    177177
    178178!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    187187        real  Ts_gcssold
    188188        real  dtime_frcg
    189         logical :: Turb_fcg_gcssold
     189        LOGICAL :: Turb_fcg_gcssold
    190190
    191191        common /turb_forcing/                                                   &
    … …  
    196196
    197197
    198         integer nlev_armcu, nt_armcu
     198        INTEGER nlev_armcu, nt_armcu
    199199        parameter (nlev_armcu=40, nt_armcu=31)
    200         integer year_ini_armcu, day_ini_armcu, mth_ini_armcu
     200        INTEGER year_ini_armcu, day_ini_armcu, mth_ini_armcu
    201201        real  heure_ini_armcu
    202         real day_ju_ini_armcu                                ! Julian day of armcu case first day
     202        REAL day_ju_ini_armcu                                ! Julian day of armcu case first day
    203203        parameter (year_ini_armcu=1997)
    204204        parameter (mth_ini_armcu=6)
    205205        parameter (day_ini_armcu=21)  ! 172 = 21 juin 1997
    206206        parameter (heure_ini_armcu=41400)   ! 11:30 en secondes
    207         real dt_armcu
     207        REAL dt_armcu
    208208        parameter (dt_armcu=1.*1800.)   ! forcages donnes ttes les demi-heures par ifa_armcu.txt
    209         real sens_armcu(nt_armcu),flat_armcu(nt_armcu)
    210         real adv_theta_armcu(nt_armcu),rad_theta_armcu(nt_armcu)
    211         real adv_qt_armcu(nt_armcu)
    212         real theta_mod(llm),rv_mod(llm),play_mod(llm)
     209        REAL sens_armcu(nt_armcu),flat_armcu(nt_armcu)
     210        REAL adv_theta_armcu(nt_armcu),rad_theta_armcu(nt_armcu)
     211        REAL adv_qt_armcu(nt_armcu)
     212        REAL theta_mod(llm),rv_mod(llm),play_mod(llm)
    213213! profc comme "profil armcu"
    214214       
    215215! forcages interpoles dans le temps
    216         real adv_theta_prof,rad_theta_prof,adv_qt_prof
    217         real sens_prof,flat_prof,fact
     216        REAL adv_theta_prof,rad_theta_prof,adv_qt_prof
     217        REAL sens_prof,flat_prof,fact
    218218!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    219219! declarations specifiques au cas Sandu
    … …  
    221221!        integer nlev_prof
    222222!        parameter (nlev_prof = 41)
    223         integer nlev_sandu, nt_sandu
     223        INTEGER nlev_sandu, nt_sandu
    224224        parameter (nlev_sandu=87, nt_sandu=13)
    225         integer year_ini_sandu, day_ini_sandu, mth_ini_sandu
    226         real day_ju_ini_sandu                                ! Julian day of sandu case first day
     225        INTEGER year_ini_sandu, day_ini_sandu, mth_ini_sandu
     226        REAL day_ju_ini_sandu                                ! Julian day of sandu case first day
    227227        parameter (year_ini_sandu=2006)
    228228        parameter (mth_ini_sandu=7)
    229229        parameter (day_ini_sandu=15)  ! 196 = 15 juillet 2006
    230         real dt_sandu, tau_sandu
     230        REAL dt_sandu, tau_sandu
    231231        logical  :: trouve_700=.TRUE.
    232232        parameter (dt_sandu=6.*3600.)   ! forcages donnes ttes les 6 heures par ifa_sandu.txt
    233233        parameter (tau_sandu=30000*3600.)  ! temps de relaxation u,v,thetal,qt vers profil init et au dessus 700hPa
    234234!!
    235         real ts_sandu(nt_sandu)
     235        REAL ts_sandu(nt_sandu)
    236236! profs comme "profil sandu"
    237         real plev_profs(nlev_sandu)
    238         real t_profs(nlev_sandu),thl_profs(nlev_sandu)
    239         real q_profs(nlev_sandu)
    240         real u_profs(nlev_sandu),v_profs(nlev_sandu),w_profs(nlev_sandu)
    241         real omega_profs(nlev_sandu),o3mmr_profs(nlev_sandu)
    242 
    243         real, dimension(llm) :: relax_u,relax_v,relax_thl
    244         real, dimension(llm,2) :: relax_q
    245 
    246         real thl_mod(llm),omega_mod(llm),o3mmr_mod(llm),tke_mod(llm)
     237        REAL plev_profs(nlev_sandu)
     238        REAL t_profs(nlev_sandu),thl_profs(nlev_sandu)
     239        REAL q_profs(nlev_sandu)
     240        REAL u_profs(nlev_sandu),v_profs(nlev_sandu),w_profs(nlev_sandu)
     241        REAL omega_profs(nlev_sandu),o3mmr_profs(nlev_sandu)
     242
     243        REAL, DIMENSION(llm) :: relax_u,relax_v,relax_thl
     244        REAL, DIMENSION(llm,2) :: relax_q
     245
     246        REAL thl_mod(llm),omega_mod(llm),o3mmr_mod(llm),tke_mod(llm)
    247247!vertical advection computation
    248         real d_t_z(llm),d_th_z(llm), d_q_z(llm)
    249         real d_t_dyn_z(llm),d_th_dyn_z(llm), d_q_dyn_z(llm)
    250         real d_u_z(llm),d_v_z(llm)
    251         real d_u_dyn(llm),d_v_dyn(llm)
    252         real d_u_dyn_z(llm),d_v_dyn_z(llm)
    253         real d_u_adv(llm),d_v_adv(llm)
    254         real zz(llm)
    255         real zfact
     248        REAL d_t_z(llm),d_th_z(llm), d_q_z(llm)
     249        REAL d_t_dyn_z(llm),d_th_dyn_z(llm), d_q_dyn_z(llm)
     250        REAL d_u_z(llm),d_v_z(llm)
     251        REAL d_u_dyn(llm),d_v_dyn(llm)
     252        REAL d_u_dyn_z(llm),d_v_dyn_z(llm)
     253        REAL d_u_adv(llm),d_v_adv(llm)
     254        REAL zz(llm)
     255        REAL zfact
    256256!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    257257! Declarations specifiques au cas Astex
    258258        character*80 :: fich_astex
    259         integer nlev_astex, nt_astex
     259        INTEGER nlev_astex, nt_astex
    260260        parameter (nlev_astex=34, nt_astex=49)
    261         integer year_ini_astex, day_ini_astex, mth_ini_astex
    262         real day_ju_ini_astex                                ! Julian day of astex case first day
     261        INTEGER year_ini_astex, day_ini_astex, mth_ini_astex
     262        REAL day_ju_ini_astex                                ! Julian day of astex case first day
    263263        parameter (year_ini_astex=1992)
    264264        parameter (mth_ini_astex=6)
    265265        parameter (day_ini_astex=13)  ! 165 = 13 juin 1992
    266         real dt_astex
     266        REAL dt_astex
    267267        parameter (dt_astex=3600.)    ! forcages donnes ttes les heures par ifa_astex.txt
    268         real ts_astex(nt_astex),div_astex(nt_astex),ug_astex(nt_astex)
    269         real vg_astex(nt_astex),ufa_astex(nt_astex),vfa_astex(nt_astex)
    270         real div_prof,ug_prof,vg_prof,ufa_prof,vfa_prof
     268        REAL ts_astex(nt_astex),div_astex(nt_astex),ug_astex(nt_astex)
     269        REAL vg_astex(nt_astex),ufa_astex(nt_astex),vfa_astex(nt_astex)
     270        REAL div_prof,ug_prof,vg_prof,ufa_prof,vfa_prof
    271271! profa comme "profil astex"
    272         real plev_profa(nlev_astex)
    273         real t_profa(nlev_astex),thl_profa(nlev_astex)
    274         real qv_profa(nlev_astex),ql_profa(nlev_astex)
    275         real qt_profa(nlev_astex),o3mmr_profa(nlev_astex)
    276         real u_profa(nlev_astex),v_profa(nlev_astex),w_profa(nlev_astex)
    277         real tke_profa(nlev_astex)
     272        REAL plev_profa(nlev_astex)
     273        REAL t_profa(nlev_astex),thl_profa(nlev_astex)
     274        REAL qv_profa(nlev_astex),ql_profa(nlev_astex)
     275        REAL qt_profa(nlev_astex),o3mmr_profa(nlev_astex)
     276        REAL u_profa(nlev_astex),v_profa(nlev_astex),w_profa(nlev_astex)
     277        REAL tke_profa(nlev_astex)
    278278
    279279!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    280280!Declarations specifiques au cas standard
    281281
    282         real w_mod_cas(llm), t_mod_cas(llm),q_mod_cas(llm)
    283         real theta_mod_cas(llm),thl_mod_cas(llm),thv_mod_cas(llm)
    284         real qv_mod_cas(llm),ql_mod_cas(llm),qi_mod_cas(llm)
    285         real ug_mod_cas(llm),vg_mod_cas(llm)
    286         real temp_nudg_mod_cas(llm),qv_nudg_mod_cas(llm),v_nudg_mod_cas(llm),u_nudg_mod_cas(llm)
    287         real invtau_temp_nudg_mod_cas(llm),invtau_qv_nudg_mod_cas(llm),invtau_v_nudg_mod_cas(llm),invtau_u_nudg_mod_cas(llm)
    288         real u_mod_cas(llm),v_mod_cas(llm)
    289         real omega_mod_cas(llm),tke_mod_cas(llm+1)
    290         real ht_mod_cas(llm),vt_mod_cas(llm),dt_mod_cas(llm),dtrad_mod_cas(llm)
    291         real hth_mod_cas(llm),vth_mod_cas(llm),dth_mod_cas(llm)
    292         real hq_mod_cas(llm),vq_mod_cas(llm),dq_mod_cas(llm)
    293         real hu_mod_cas(llm),vu_mod_cas(llm),du_mod_cas(llm)
    294         real hv_mod_cas(llm),vv_mod_cas(llm),dv_mod_cas(llm)
    295         integer day_ini_cas
    296 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    297 
    298 
     282        REAL w_mod_cas(llm), t_mod_cas(llm),q_mod_cas(llm)
     283        REAL theta_mod_cas(llm),thl_mod_cas(llm),thv_mod_cas(llm)
     284        REAL qv_mod_cas(llm),ql_mod_cas(llm),qi_mod_cas(llm)
     285        REAL ug_mod_cas(llm),vg_mod_cas(llm)
     286        REAL temp_nudg_mod_cas(llm),qv_nudg_mod_cas(llm),v_nudg_mod_cas(llm),u_nudg_mod_cas(llm)
     287        REAL invtau_temp_nudg_mod_cas(llm),invtau_qv_nudg_mod_cas(llm),invtau_v_nudg_mod_cas(llm),invtau_u_nudg_mod_cas(llm)
     288        REAL u_mod_cas(llm),v_mod_cas(llm)
     289        REAL omega_mod_cas(llm),tke_mod_cas(llm+1)
     290        REAL ht_mod_cas(llm),vt_mod_cas(llm),dt_mod_cas(llm),dtrad_mod_cas(llm)
     291        REAL hth_mod_cas(llm),vth_mod_cas(llm),dth_mod_cas(llm)
     292        REAL hq_mod_cas(llm),vq_mod_cas(llm),dq_mod_cas(llm)
     293        REAL hu_mod_cas(llm),vu_mod_cas(llm),du_mod_cas(llm)
     294        REAL hv_mod_cas(llm),vv_mod_cas(llm),dv_mod_cas(llm)
     295        INTEGER day_ini_cas
     296!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     297
     298

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/1D_interp_cases.h

    r5116 r5117  
    3232! EV tg instead of ts_cur
    3333             tg = ts_prof_cas
    34              if ((tg .eq. 0.) .and. (tskin_prof_cas .ne. 0.)) THEN
     34             IF ((tg .EQ. 0.) .AND. (tskin_prof_cas .NE. 0.)) THEN
    3535                tg=tskin_prof_cas
    3636              endif
    … …  
    7878      d_u_dyn_z(:)=0.
    7979      d_v_dyn_z(:)=0.
    80       if (1==0) THEN
     80      IF (1==0) THEN
    8181         DO l=2,llm-1
    8282          d_t_z(l)=(temp(l+1)-temp(l-1))/(play(l+1)-play(l-1))
    … …  
    132132
    133133!geostrophic wind
    134       if (forc_geo.eq.1) THEN
     134      IF (forc_geo.EQ.1) THEN
    135135        do l=1,llm
    136136        ug(l) = ug_mod_cas(l)
    … …  
    168168!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    169169         
    170         if (trad.eq.1) THEN
     170        IF (trad.EQ.1) THEN
    171171           tend_rayo=1
    172172           dt_cooling(l) = dtrad_mod_cas(l)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/1D_read_forc_cases.h

    r5116 r5117  
    1212
    1313      PRINT*,'FORCING ,forcing_SCM',forcing_SCM
    14       if (forcing_SCM) THEN
     14      IF (forcing_SCM) THEN
    1515         WRITE(*,*),'avant CALL read_SCM'
    1616         CALL read_SCM_cas
    … …  
    7676
    7777      !initial surface temperature
    78       if (tskin_prof_cas .NE. 0.) THEN
     78      IF (tskin_prof_cas .NE. 0.) THEN
    7979      ! we take the first value of the prescribed ts
    8080          tsurf=tskin_prof_cas
    81       else if (ts_prof_cas .NE. 0) THEN
     81      ELSE IF (ts_prof_cas .NE. 0) THEN
    8282      ! if an initial ts value is present, we take it
    8383          tsurf=ts_prof_cas
    … …  
    8686      ! ts forcing during the run (if any)
    8787      tg = ts_prof_cas
    88       if ((tg .eq. 0.) .and. (tskin_prof_cas .NE. 0.)) THEN
     88      IF ((tg .EQ. 0.) .AND. (tskin_prof_cas .NE. 0.)) THEN
    8989          tg=tskin_prof_cas
    9090      endif

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/compar1d.h

    r5116 r5117  
    3030      REAL :: zpicinp
    3131
    32       logical :: restart
    33       logical :: ok_old_disvert
     32      LOGICAL :: restart
     33      LOGICAL :: ok_old_disvert
    3434
    3535! Pour les forcages communs: ces entiers valent 0 ou 1

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/fcg_racmo.h

    r5116 r5117  
    33
    44      real   :: a_guide
    5       logical :: ok_invertp
     5      LOGICAL :: ok_invertp
    66      INTEGER :: forc_trb
    77      character*31 :: fich_racmo

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_1dutils.f90

    r5116 r5117  
    6262  SUBROUTINE conf_unicol
    6363
    64     use IOIPSL
     64    USE IOIPSL
    6565    USE lmdz_print_control, ONLY: lunout
    6666    !-----------------------------------------------------------------------
    … …  
    9797    lunout = 6
    9898    !      CALL getin('lunout', lunout)
    99     IF (lunout /= 5 .and. lunout /= 6) THEN
     99    IF (lunout /= 5 .AND. lunout /= 6) THEN
    100100      OPEN(lunout, FILE = 'lmdz.out')
    101101    ENDIF
    … …  
    711711    USE lmdz_write_field_phy
    712712    USE infotrac
    713     use control_mod
     713    USE control_mod
    714714    USE comconst_mod, ONLY: im, jm, lllm
    715715    USE logic_mod, ONLY: fxyhypb, ysinus
    … …  
    844844    USE iostart
    845845    USE infotrac
    846     use control_mod
     846    USE control_mod
    847847    USE comconst_mod, ONLY: cpp, daysec, dtvr, g, kappa, omeg, rad
    848848    USE logic_mod, ONLY: fxyhypb, ysinus
    … …  
    10321032
    10331033    CHARACTER(LEN = *) modname
    1034     integer ierr
     1034    INTEGER ierr
    10351035    CHARACTER(LEN = *) message
    10361036
    … …  
    10461046    CALL getin_dump
    10471047
    1048     if (ierr == 0) THEN
     1048    IF (ierr == 0) THEN
    10491049      WRITE(*, *) 'Everything is cool'
    10501050    else
    … …  
    12481248    IMPLICIT NONE
    12491249    ! arguments
    1250     integer llm
    1251     real w(llm + 1), q(llm), plev(llm + 1), dt
     1250    INTEGER llm
     1251    REAL w(llm + 1), q(llm), plev(llm + 1), dt
    12521252
    12531253    ! local
    1254     integer l
    1255     real zwq(llm + 1), zm(llm + 1), zw(llm + 1)
    1256     real qold
     1254    INTEGER l
     1255    REAL zwq(llm + 1), zm(llm + 1), zw(llm + 1)
     1256    REAL qold
    12571257
    12581258    !---------------------------------------------------------------
    … …  
    12851285    include "YOMCST.h"
    12861286    !        argument
    1287     integer llm
     1287    INTEGER llm
    12881288    real  omega(llm + 1), d_t_va(llm), d_q_va(llm, 3)
    12891289    real  d_u_va(llm), d_v_va(llm)
    … …  
    12921292    real  play(llm)
    12931293    ! interne
    1294     integer l
    1295     real alpha, omgdown, omgup
     1294    INTEGER l
     1295    REAL alpha, omgdown, omgup
    12961296
    12971297    do l = 1, llm
    … …  
    13571357    include "YOMCST.h"
    13581358    !        argument
    1359     integer llm, nqtot
     1359    INTEGER llm, nqtot
    13601360    real  omega(llm + 1), d_t_va(llm), d_q_va(llm, nqtot)
    13611361    !        real  d_u_va(llm), d_v_va(llm)
    … …  
    13631363    real  u(llm), v(llm)
    13641364    real  play(llm)
    1365     real cor(llm)
     1365    REAL cor(llm)
    13661366    !        real dph(llm),dudp(llm),dvdp(llm),dqdp(llm),dtdp(llm)
    1367     real dph(llm), dqdp(llm), dtdp(llm)
     1367    REAL dph(llm), dqdp(llm), dtdp(llm)
    13681368    ! interne
    1369     integer k
    1370     real omdn, omup
     1369    INTEGER k
     1370    REAL omdn, omup
    13711371
    13721372    !        dudp=0.
    … …  
    16731673    !-------------------------------------------------------------------------
    16741674
    1675     integer nlevmax
     1675    INTEGER nlevmax
    16761676    parameter (nlevmax = 41)
    1677     integer nlev_cas, mxcalc
     1677    INTEGER nlev_cas, mxcalc
    16781678    !       real play(llm), plev_prof(nlevmax)
    16791679    !       real t_prof(nlevmax),q_prof(nlevmax)
    … …  
    16821682    !       real hq_prof(nlevmax),vq_prof(nlevmax)
    16831683
    1684     real play(llm), plev_prof_cas(nlev_cas)
    1685     real t_prof_cas(nlev_cas), th_prof_cas(nlev_cas), thv_prof_cas(nlev_cas), thl_prof_cas(nlev_cas)
    1686     real qv_prof_cas(nlev_cas), ql_prof_cas(nlev_cas), qi_prof_cas(nlev_cas)
    1687     real u_prof_cas(nlev_cas), v_prof_cas(nlev_cas)
    1688     real ug_prof_cas(nlev_cas), vg_prof_cas(nlev_cas), vitw_prof_cas(nlev_cas), omega_prof_cas(nlev_cas)
    1689     real du_prof_cas(nlev_cas), hu_prof_cas(nlev_cas), vu_prof_cas(nlev_cas)
    1690     real dv_prof_cas(nlev_cas), hv_prof_cas(nlev_cas), vv_prof_cas(nlev_cas)
    1691     real dt_prof_cas(nlev_cas), ht_prof_cas(nlev_cas), vt_prof_cas(nlev_cas), dtrad_prof_cas(nlev_cas)
    1692     real dth_prof_cas(nlev_cas), hth_prof_cas(nlev_cas), vth_prof_cas(nlev_cas)
    1693     real dq_prof_cas(nlev_cas), hq_prof_cas(nlev_cas), vq_prof_cas(nlev_cas)
    1694 
    1695     real t_mod_cas(llm), theta_mod_cas(llm), thv_mod_cas(llm), thl_mod_cas(llm)
    1696     real qv_mod_cas(llm), ql_mod_cas(llm), qi_mod_cas(llm)
    1697     real u_mod_cas(llm), v_mod_cas(llm)
    1698     real ug_mod_cas(llm), vg_mod_cas(llm), w_mod_cas(llm), omega_mod_cas(llm)
    1699     real du_mod_cas(llm), hu_mod_cas(llm), vu_mod_cas(llm)
    1700     real dv_mod_cas(llm), hv_mod_cas(llm), vv_mod_cas(llm)
    1701     real dt_mod_cas(llm), ht_mod_cas(llm), vt_mod_cas(llm), dtrad_mod_cas(llm)
    1702     real dth_mod_cas(llm), hth_mod_cas(llm), vth_mod_cas(llm)
    1703     real dq_mod_cas(llm), hq_mod_cas(llm), vq_mod_cas(llm)
    1704 
    1705     integer l, k, k1, k2
    1706     real frac, frac1, frac2, fact
     1684    REAL play(llm), plev_prof_cas(nlev_cas)
     1685    REAL t_prof_cas(nlev_cas), th_prof_cas(nlev_cas), thv_prof_cas(nlev_cas), thl_prof_cas(nlev_cas)
     1686    REAL qv_prof_cas(nlev_cas), ql_prof_cas(nlev_cas), qi_prof_cas(nlev_cas)
     1687    REAL u_prof_cas(nlev_cas), v_prof_cas(nlev_cas)
     1688    REAL ug_prof_cas(nlev_cas), vg_prof_cas(nlev_cas), vitw_prof_cas(nlev_cas), omega_prof_cas(nlev_cas)
     1689    REAL du_prof_cas(nlev_cas), hu_prof_cas(nlev_cas), vu_prof_cas(nlev_cas)
     1690    REAL dv_prof_cas(nlev_cas), hv_prof_cas(nlev_cas), vv_prof_cas(nlev_cas)
     1691    REAL dt_prof_cas(nlev_cas), ht_prof_cas(nlev_cas), vt_prof_cas(nlev_cas), dtrad_prof_cas(nlev_cas)
     1692    REAL dth_prof_cas(nlev_cas), hth_prof_cas(nlev_cas), vth_prof_cas(nlev_cas)
     1693    REAL dq_prof_cas(nlev_cas), hq_prof_cas(nlev_cas), vq_prof_cas(nlev_cas)
     1694
     1695    REAL t_mod_cas(llm), theta_mod_cas(llm), thv_mod_cas(llm), thl_mod_cas(llm)
     1696    REAL qv_mod_cas(llm), ql_mod_cas(llm), qi_mod_cas(llm)
     1697    REAL u_mod_cas(llm), v_mod_cas(llm)
     1698    REAL ug_mod_cas(llm), vg_mod_cas(llm), w_mod_cas(llm), omega_mod_cas(llm)
     1699    REAL du_mod_cas(llm), hu_mod_cas(llm), vu_mod_cas(llm)
     1700    REAL dv_mod_cas(llm), hv_mod_cas(llm), vv_mod_cas(llm)
     1701    REAL dt_mod_cas(llm), ht_mod_cas(llm), vt_mod_cas(llm), dtrad_mod_cas(llm)
     1702    REAL dth_mod_cas(llm), hth_mod_cas(llm), vth_mod_cas(llm)
     1703    REAL dq_mod_cas(llm), hq_mod_cas(llm), vq_mod_cas(llm)
     1704
     1705    INTEGER l, k, k1, k2
     1706    REAL frac, frac1, frac2, fact
    17071707
    17081708    !       do l = 1, llm
    … …  
    17151715    do l = 1, llm
    17161716
    1717       if (play(l)>=plev_prof_cas(nlev_cas)) THEN
     1717      IF (play(l)>=plev_prof_cas(nlev_cas)) THEN
    17181718        mxcalc = l
    17191719        !        print *,'debut interp2, mxcalc=',mxcalc
    … …  
    17211721        k2 = 0
    17221722
    1723         if (play(l)<=plev_prof_cas(1)) THEN
     1723        IF (play(l)<=plev_prof_cas(1)) THEN
    17241724          do k = 1, nlev_cas - 1
    1725             if (play(l)<=plev_prof_cas(k).and. play(l)>plev_prof_cas(k + 1)) THEN
     1725            IF (play(l)<=plev_prof_cas(k).AND. play(l)>plev_prof_cas(k + 1)) THEN
    17261726              k1 = k
    17271727              k2 = k + 1
    … …  
    17291729          enddo
    17301730
    1731           if (k1==0 .or. k2==0) THEN
     1731          IF (k1==0 .OR. k2==0) THEN
    17321732            WRITE(*, *) 'PB! k1, k2 = ', k1, k2
    17331733            WRITE(*, *) 'l,play(l) = ', l, play(l) / 100

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_old_1dconv.f90

    r5116 r5117  
    2727    REAL hplaym(100) !pression en hPa milieux des couches Meso-NH
    2828
    29     integer i, j, k, ll, in
     29    INTEGER i, j, k, ll, in
    3030
    3131    CHARACTER*80 file_forctl, file_fordat
    … …  
    4545    !       dt         :pas de temps du meso_NH (en secondes)
    4646    !----------------------------------------------------------------------
    47     integer pasmax, dt
     47    INTEGER pasmax, dt
    4848    save pasmax, dt
    4949    !----------------------------------------------------------------------
    … …  
    6060    !           hv     : idem le long de y.
    6161    !           Ts     : Temperature de surface (K)
    62     !           imp_fcg: var. logical .eq. T si forcage en impulsion
    63     !           ts_fcg: var. logical .eq. T si forcage en Ts present dans fichier
    64     !           Tp_fcg: var. logical .eq. T si forcage donne en Temp potentielle
    65     !           Turb_fcg: var. logical .eq. T si forcage turbulent present dans fichier
    66     !----------------------------------------------------------------------
    67     integer itap
    68     real dtime
    69     real ht(100)
    70     real hq(100)
    71     real hu(100)
    72     real hv(100)
    73     real hw(100)
    74     real hthturb(100)
    75     real hqturb(100)
    76     real Ts, Ts_subr
    77     logical imp_fcg
    78     logical ts_fcg
    79     logical Tp_fcg
    80     logical Turb_fcg
     62    !           imp_fcg: var. LOGICAL .EQ. T si forcage en impulsion
     63    !           ts_fcg: var. LOGICAL .EQ. T si forcage en Ts present dans fichier
     64    !           Tp_fcg: var. LOGICAL .EQ. T si forcage donne en Temp potentielle
     65    !           Turb_fcg: var. LOGICAL .EQ. T si forcage turbulent present dans fichier
     66    !----------------------------------------------------------------------
     67    INTEGER itap
     68    REAL dtime
     69    REAL ht(100)
     70    REAL hq(100)
     71    REAL hu(100)
     72    REAL hv(100)
     73    REAL hw(100)
     74    REAL hthturb(100)
     75    REAL hqturb(100)
     76    REAL Ts, Ts_subr
     77    LOGICAL imp_fcg
     78    LOGICAL ts_fcg
     79    LOGICAL Tp_fcg
     80    LOGICAL Turb_fcg
    8181    !----------------------------------------------------------------------
    8282    ! Variables internes de get_uvd (note : l interpolation temporelle
    … …  
    100100    !     tsbef     : surface temperature 'before time step'
    101101    !----------------------------------------------------------------------
    102     integer time0, pas, pasprev
     102    INTEGER time0, pas, pasprev
    103103    save time0, pas, pasprev
    104     real time
    105     real htaft(100), hqaft(100), hwaft(100), huaft(100), hvaft(100)
    106     real hthturbaft(100), hqturbaft(100)
    107     real Tsaft
     104    REAL time
     105    REAL htaft(100), hqaft(100), hwaft(100), huaft(100), hvaft(100)
     106    REAL hthturbaft(100), hqturbaft(100)
     107    REAL Tsaft
    108108    save htaft, hqaft, hwaft, huaft, hvaft, hthturbaft, hqturbaft
    109     real htbef(100), hqbef(100), hwbef(100), hubef(100), hvbef(100)
    110     real hthturbbef(100), hqturbbef(100)
    111     real Tsbef
     109    REAL htbef(100), hqbef(100), hwbef(100), hubef(100), hvbef(100)
     110    REAL hthturbbef(100), hqturbbef(100)
     111    REAL Tsbef
    112112    save htbef, hqbef, hwbef, hubef, hvbef, hthturbbef, hqturbbef
    113113
    114     real timeaft, timebef
     114    REAL timeaft, timebef
    115115    save timeaft, timebef
    116     integer temps
     116    INTEGER temps
    117117    character*4 string
    118118    !----------------------------------------------------------------------
    119119    ! variables arguments de la subroutine rdgrads
    120120    !---------------------------------------------------------------------
    121     integer icompt, icomp1 !compteurs de rdgrads
    122     real z(100)         ! altitude (grille Meso)
    123     real ht_mes(100)    !convergence horizontale de temperature
     121    INTEGER icompt, icomp1 !compteurs de rdgrads
     122    REAL z(100)         ! altitude (grille Meso)
     123    REAL ht_mes(100)    !convergence horizontale de temperature
    124124    !-(grille Meso)
    125     real hq_mes(100)    !convergence horizontale d humidite
     125    REAL hq_mes(100)    !convergence horizontale d humidite
    126126    !(grille Meso)
    127     real hw_mes(100)    !vitesse verticale moyenne
     127    REAL hw_mes(100)    !vitesse verticale moyenne
    128128    !(grille Meso)
    129     real hu_mes(100), hv_mes(100)    !convergence horizontale d impulsion
     129    REAL hu_mes(100), hv_mes(100)    !convergence horizontale d impulsion
    130130    !(grille Meso)
    131     real hthturb_mes(100) !tendance horizontale de T_pot, due aux
     131    REAL hthturb_mes(100) !tendance horizontale de T_pot, due aux
    132132    !flux turbulents
    133     real hqturb_mes(100) !tendance horizontale d humidite, due aux
     133    REAL hqturb_mes(100) !tendance horizontale d humidite, due aux
    134134    !flux turbulents
    135135
    … …  
    143143    !---------------------------------------------------------------------
    144144    character*80 aaa, atemps, spaces, apasmax
    145     integer nch, imn, ipa
     145    INTEGER nch, imn, ipa
    146146    !---------------------------------------------------------------------
    147147    !  procedures appelees
    … …  
    220220      !*** gcm . on obtient le nouveau champ after                    ***
    221221      do k = 1, klev
    222         if (JM(k) == 0) THEN
     222        IF (JM(k) == 0) THEN
    223223          htaft(k) = ht_mes(jm(k) + 1)
    224224          hqaft(k) = hq_mes(jm(k) + 1)
    … …  
    232232            hqTurbaft(k) = hqTurb_mes(jm(k) + 1)
    233233          endif ! Turb_fcg
    234         else ! JM(k) .eq. 0
     234        else ! JM(k) .EQ. 0
    235235          htaft(k) = coef1(k) * ht_mes(jm(k)) + coef2(k) * ht_mes(jm(k) + 1)
    236236          hqaft(k) = coef1(k) * hq_mes(jm(k)) + coef2(k) * hq_mes(jm(k) + 1)
    … …  
    246246                    & + coef2(k) * hqTurb_mes(jm(k) + 1)
    247247          endif ! Turb_fcg
    248         endif ! JM(k) .eq. 0
     248        endif ! JM(k) .EQ. 0
    249249      enddo
    250250      tsaft = ts_subr
    … …  
    323323      read(97, 1000, end = 999) string
    324324      1000 format (a4)
    325       if (string == 'TDEF') go to 50
     325      IF (string == 'TDEF') go to 50
    326326    enddo
    327327    50   backspace(97)
    … …  
    397397    !-----------------------------------------------------------------------
    398398    do k = 1, klev
    399       if (JM(k) == 0) THEN
     399      IF (JM(k) == 0) THEN
    400400        !FKC bug? ne faut il pas convertir tsol en tendance ????
    401401        !RT bug taken care of by removing the stuff
    … …  
    411411          hqTurbaft(k) = hqTurb_mes(jm(k) + 1)
    412412        endif ! Turb_fcg
    413       else ! JM(k) .eq. 0
     413      else ! JM(k) .EQ. 0
    414414        htaft(k) = coef1(k) * ht_mes(jm(k)) + coef2(k) * ht_mes(jm(k) + 1)
    415415        hqaft(k) = coef1(k) * hq_mes(jm(k)) + coef2(k) * hq_mes(jm(k) + 1)
    … …  
    425425                  & + coef2(k) * hqTurb_mes(jm(k) + 1)
    426426        endif ! Turb_fcg
    427       endif ! JM(k) .eq. 0
     427      endif ! JM(k) .EQ. 0
    428428    enddo
    429429    tsaft = ts_subr
    … …  
    457457  SUBROUTINE advect_tvl(dtime, zt, zq, vu_f, vv_f, t_f, q_f                   &
    458458          &, d_t_adv, d_q_adv)
    459     use dimphy
     459    USE dimphy
    460460    IMPLICIT NONE
    461461
    … …  
    463463    !cccc      INCLUDE "dimphy.h"
    464464
    465     integer k
    466     real dtime, fact, du, dv, cx, cy, alx, aly
    467     real zt(klev), zq(klev, 3)
    468     real vu_f(klev), vv_f(klev), t_f(klev), q_f(klev, 3)
    469 
    470     real d_t_adv(klev), d_q_adv(klev, 3)
     465    INTEGER k
     466    REAL dtime, fact, du, dv, cx, cy, alx, aly
     467    REAL zt(klev), zq(klev, 3)
     468    REAL vu_f(klev), vv_f(klev), t_f(klev), q_f(klev, 3)
     469
     470    REAL d_t_adv(klev), d_q_adv(klev, 3)
    471471
    472472    ! Velocity of moving cell
    … …  
    509509    COMMON/com2_phys_gcss/playm, hplaym, nblvlm
    510510
    511     integer k, klevgcm
    512     real playgcm(klevgcm) ! pression en milieu de couche du gcm
    513     real psolgcm
     511    INTEGER k, klevgcm
     512    REAL playgcm(klevgcm) ! pression en milieu de couche du gcm
     513    REAL psolgcm
    514514    character*80 file_forctl
    515515
    … …  
    584584    character*4 a
    585585    character*80 aaa, anblvl, spaces
    586     integer nch
     586    INTEGER nch
    587587
    588588    lu = 9
    … …  
    591591    do i = 1, 1000
    592592      read(lu, 1000, end = 999) a
    593       if (a == 'ZDEF') go to 100
     593      IF (a == 'ZDEF') go to 100
    594594    enddo
    595595
    … …  
    610610    read(lu, *) (playm(mlz), mlz = 1, nblvlm)
    611611    !      Si la pression est en HPa, la multiplier par 100
    612     if (playm(1) < 10000.) THEN
     612    IF (playm(1) < 10000.) THEN
    613613      do mlz = 1, nblvlm
    614614        playm(mlz) = playm(mlz) * 100.
    … …  
    637637    IMPLICIT none
    638638    INTEGER itape, icount, icomp, nl
    639     real z(nl), ht(nl), hq(nl), hw(nl), hu(nl), hv(nl)
    640     real hthtur(nl), hqtur(nl)
    641     real ts
     639    REAL z(nl), ht(nl), hq(nl), hw(nl), hu(nl), hv(nl)
     640    REAL hthtur(nl), hqtur(nl)
     641    REAL ts
    642642
    643643    INTEGER k
    … …  
    729729    do k = 1, klev
    730730      val = play(k)
    731       if (val > playm(1)) THEN
     731      IF (val > playm(1)) THEN
    732732        mlz = 0
    733733        JM(1) = mlz
    734734        coef1(1) = (playm(mlz + 1) - val) / (playm(mlz + 1) - psol)
    735735        coef2(1) = (val - psol) / (playm(mlz + 1) - psol)
    736       else if (val > playm(nblvlm)) THEN
     736      ELSE IF (val > playm(nblvlm)) THEN
    737737        do mlz = 1, nblvlm
    738           if (val <= playm(mlz).and. val > playm(mlz + 1))THEN
     738          IF (val <= playm(mlz).AND. val > playm(mlz + 1))THEN
    739739            JM(k) = mlz
    740740            coef1(k) = (playm(mlz + 1) - val) / (playm(mlz + 1) - playm(mlz))
    … …  
    807807        IF(END==BEG - 2) END = LENGTH
    808808        !*        PRINT *,'NTH,LENGTH,N,BEG,END=',NTH,LENGTH,N,BEG,END
    809       end do
     809      end DO
    810810      NCH = END - BEG + 1
    811811      IF(NCH>0) SST = STR(BEG:END)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_old_lmdz1d.F90

    r5116 r5117  
    6767    !---------------------------------------------------------------------
    6868
    69     integer, parameter :: ngrid = 1
     69    INTEGER, parameter :: ngrid = 1
    7070    REAL :: zcufi = 1.
    7171    REAL :: zcvfi = 1.
    7272
    7373    !-      REAL :: nat_surf
    74     !-      logical :: ok_flux_surf
     74    !-      LOGICAL :: ok_flux_surf
    7575    !-      REAL :: fsens
    7676    !-      REAL :: flat
    … …  
    107107
    108108    INTEGER :: kmax = llm
    109     integer llm700, nq1, nq2
     109    INTEGER llm700, nq1, nq2
    110110    INTEGER, PARAMETER :: nlev_max = 1000, nqmx = 1000
    111     real timestep, frac
    112     real height(nlev_max), tttprof(nlev_max), qtprof(nlev_max)
     111    REAL timestep, frac
     112    REAL height(nlev_max), tttprof(nlev_max), qtprof(nlev_max)
    113113    real  uprof(nlev_max), vprof(nlev_max), e12prof(nlev_max)
    114114    real  ugprof(nlev_max), vgprof(nlev_max), wfls(nlev_max)
    … …  
    118118
    119119    !        INTEGER :: forcing_type
    120     logical :: forcing_les = .FALSE.
    121     logical :: forcing_armcu = .FALSE.
    122     logical :: forcing_rico = .FALSE.
    123     logical :: forcing_radconv = .FALSE.
    124     logical :: forcing_toga = .FALSE.
    125     logical :: forcing_twpice = .FALSE.
    126     logical :: forcing_amma = .FALSE.
    127     logical :: forcing_dice = .FALSE.
    128     logical :: forcing_gabls4 = .FALSE.
    129 
    130     logical :: forcing_GCM2SCM = .FALSE.
    131     logical :: forcing_GCSSold = .FALSE.
    132     logical :: forcing_sandu = .FALSE.
    133     logical :: forcing_astex = .FALSE.
    134     logical :: forcing_fire = .FALSE.
    135     logical :: forcing_case = .FALSE.
    136     logical :: forcing_case2 = .FALSE.
    137     logical :: forcing_SCM = .FALSE.
     120    LOGICAL :: forcing_les = .FALSE.
     121    LOGICAL :: forcing_armcu = .FALSE.
     122    LOGICAL :: forcing_rico = .FALSE.
     123    LOGICAL :: forcing_radconv = .FALSE.
     124    LOGICAL :: forcing_toga = .FALSE.
     125    LOGICAL :: forcing_twpice = .FALSE.
     126    LOGICAL :: forcing_amma = .FALSE.
     127    LOGICAL :: forcing_dice = .FALSE.
     128    LOGICAL :: forcing_gabls4 = .FALSE.
     129
     130    LOGICAL :: forcing_GCM2SCM = .FALSE.
     131    LOGICAL :: forcing_GCSSold = .FALSE.
     132    LOGICAL :: forcing_sandu = .FALSE.
     133    LOGICAL :: forcing_astex = .FALSE.
     134    LOGICAL :: forcing_fire = .FALSE.
     135    LOGICAL :: forcing_case = .FALSE.
     136    LOGICAL :: forcing_case2 = .FALSE.
     137    LOGICAL :: forcing_SCM = .FALSE.
    138138    INTEGER :: type_ts_forcing ! 0 = SST constant; 1 = SST read from a file
    139139    !                                                            (cf read_tsurf1d.F)
    140140
    141     real wwww
     141    REAL wwww
    142142    !vertical advection computation
    143143    !       real d_t_z(llm), d_q_z(llm)
    … …  
    147147
    148148    !flag forcings
    149     logical :: nudge_wind = .TRUE.
    150     logical :: nudge_thermo = .FALSE.
    151     logical :: cptadvw = .TRUE.
     149    LOGICAL :: nudge_wind = .TRUE.
     150    LOGICAL :: nudge_thermo = .FALSE.
     151    LOGICAL :: cptadvw = .TRUE.
    152152    !=====================================================================
    153153    ! DECLARATIONS FOR EACH CASE
    … …  
    163163    INTEGER :: inudge_RHT = 1
    164164    INTEGER :: inudge_UV = 2
    165     logical :: nudge(nudge_max)
     165    LOGICAL :: nudge(nudge_max)
    166166    REAL :: t_targ(llm)
    167167    REAL :: rh_targ(llm)
    … …  
    214214    !  Call to phyredem
    215215    !---------------------------------------------------------------------
    216     logical :: ok_writedem = .TRUE.
     216    LOGICAL :: ok_writedem = .TRUE.
    217217    REAL :: sollw_in = 0.
    218218    REAL :: solsw_in = 0.
    … …  
    221221    !  Call to physiq
    222222    !---------------------------------------------------------------------
    223     logical :: firstcall = .TRUE.
    224     logical :: lastcall = .FALSE.
     223    LOGICAL :: firstcall = .TRUE.
     224    LOGICAL :: lastcall = .FALSE.
    225225    REAL :: phis(1) = 0.0
    226226    REAL :: dpsrf(1)
    … …  
    229229    !  Initializations of boundary conditions
    230230    !---------------------------------------------------------------------
    231     real, allocatable :: phy_nat (:)  ! 0=ocean libre,1=land,2=glacier,3=banquise
    232     real, allocatable :: phy_alb (:)  ! Albedo land only (old value condsurf_jyg=0.3)
    233     real, allocatable :: phy_sst (:)  ! SST (will not be used; cf read_tsurf1d.F)
    234     real, allocatable :: phy_bil (:)  ! Ne sert que pour les slab_ocean
    235     real, allocatable :: phy_rug (:) ! Longueur rugosite utilisee sur land only
    236     real, allocatable :: phy_ice (:) ! Fraction de glace
    237     real, allocatable :: phy_fter(:) ! Fraction de terre
    238     real, allocatable :: phy_foce(:) ! Fraction de ocean
    239     real, allocatable :: phy_fsic(:) ! Fraction de glace
    240     real, allocatable :: phy_flic(:) ! Fraction de glace
     231    REAL, ALLOCATABLE :: phy_nat (:)  ! 0=ocean libre,1=land,2=glacier,3=banquise
     232    REAL, ALLOCATABLE :: phy_alb (:)  ! Albedo land only (old value condsurf_jyg=0.3)
     233    REAL, ALLOCATABLE :: phy_sst (:)  ! SST (will not be used; cf read_tsurf1d.F)
     234    REAL, ALLOCATABLE :: phy_bil (:)  ! Ne sert que pour les slab_ocean
     235    REAL, ALLOCATABLE :: phy_rug (:) ! Longueur rugosite utilisee sur land only
     236    REAL, ALLOCATABLE :: phy_ice (:) ! Fraction de glace
     237    REAL, ALLOCATABLE :: phy_fter(:) ! Fraction de terre
     238    REAL, ALLOCATABLE :: phy_foce(:) ! Fraction de ocean
     239    REAL, ALLOCATABLE :: phy_fsic(:) ! Fraction de glace
     240    REAL, ALLOCATABLE :: phy_flic(:) ! Fraction de glace
    241241
    242242    !---------------------------------------------------------------------
    … …  
    245245    INTEGER :: k, l, i, it = 1, mxcalc
    246246    INTEGER :: nsrf
    247     integer jcode
     247    INTEGER jcode
    248248    INTEGER read_climoz
    249249
    250250    INTEGER :: it_end ! iteration number of the last call
    251251    !Al1
    252     integer ecrit_slab_oc !1=ecrit,-1=lit,0=no file
     252    INTEGER ecrit_slab_oc !1=ecrit,-1=lit,0=no file
    253253    data ecrit_slab_oc/-1/
    254254
    … …  
    355355    !             Radiation to be switched off
    356356
    357     if (forcing_type <=0) THEN
     357    IF (forcing_type <=0) THEN
    358358      forcing_les = .TRUE.
    359359    elseif (forcing_type ==1) THEN
    … …  
    446446
    447447    type_ts_forcing = 0
    448     if (forcing_toga.or.forcing_sandu.or.forcing_astex .or. forcing_dice)                 &
     448    IF (forcing_toga.OR.forcing_sandu.OR.forcing_astex .OR. forcing_dice)                 &
    449449            type_ts_forcing = 1
    450450
    451     ! Initialization of the logical switch for nudging
     451    ! Initialization of the LOGICAL switch for nudging
    452452    jcode = iflag_nudge
    453453    do i = 1, nudge_max
    … …  
    484484
    485485    !      calend = 'earth_365d'
    486     if (calend == 'earth_360d') THEN
     486    IF (calend == 'earth_360d') THEN
    487487      CALL ioconf_calendar('360_day')
    488488      WRITE(*, *)'CALENDRIER CHOISI: Terrestre a 360 jours/an'
    489     else if (calend == 'earth_365d') THEN
     489    ELSE IF (calend == 'earth_365d') THEN
    490490      CALL ioconf_calendar('noleap')
    491491      WRITE(*, *)'CALENDRIER CHOISI: Terrestre a 365 jours/an'
    492     else if (calend == 'earth_366d') THEN
     492    ELSE IF (calend == 'earth_366d') THEN
    493493      CALL ioconf_calendar('all_leap')
    494494      WRITE(*, *)'CALENDRIER CHOISI: Terrestre bissextile'
    495     else if (calend == 'gregorian') THEN
     495    ELSE IF (calend == 'gregorian') THEN
    496496      stop 'gregorian calend should not be used by normal user'
    497497      CALL ioconf_calendar('gregorian') ! not to be used by normal users
    … …  
    509509    !      Le numero du jour est dans "day". L heure est traitee separement.
    510510    !      La date complete est dans "daytime" (l'unite est le jour).
    511     if (nday>0) THEN
     511    IF (nday>0) THEN
    512512      fnday = nday
    513513    else
    … …  
    606606    CALL init_infotrac
    607607
    608     if (nqtot>nqmx) STOP 'Augmenter nqmx dans lmdz1d.F'
     608    IF (nqtot>nqmx) STOP 'Augmenter nqmx dans lmdz1d.F'
    609609    allocate(q(llm, nqtot)) ; q(:, :) = 0.
    610610    allocate(dq(llm, nqtot))
    … …  
    627627    CALL phys_state_var_init(read_climoz)
    628628
    629     if (ngrid/=klon) THEN
     629    IF (ngrid/=klon) THEN
    630630      PRINT*, 'stop in inifis'
    631631      PRINT*, 'Probleme de dimensions :'
    … …  
    655655    !! mpl et jyg le 22/08/2012 :
    656656    !!  pour que les cas a flux de surface imposes marchent
    657     IF(.NOT.ok_flux_surf.or.max(abs(wtsurf), abs(wqsurf))>0.) THEN
     657    IF(.NOT.ok_flux_surf.OR.max(abs(wtsurf), abs(wqsurf))>0.) THEN
    658658      fsens = -wtsurf * rcpd * rho(1)
    659659      flat = -wqsurf * rlvtt * rho(1)
    … …  
    695695      do l = 1, llm
    696696        WRITE(*, *) 'l,play(l),presnivs(l): ', l, play(l), presnivs(l)
    697         if (trouve_700 .and. play(l)<=70000) THEN
     697        IF (trouve_700 .AND. play(l)<=70000) THEN
    698698          llm700 = l
    699699          print *, 'llm700,play=', llm700, play(l) / 100.
    … …  
    812812        PRINT*, 'avant phyredem'
    813813        pctsrf(1, :) = 0.
    814         if (nat_surf==0.) THEN
     814        IF (nat_surf==0.) THEN
    815815        pctsrf(1, is_oce) = 1.
    816816        pctsrf(1, is_ter) = 0.
    817817        pctsrf(1, is_lic) = 0.
    818818        pctsrf(1, is_sic) = 0.
    819         else if (nat_surf == 1) THEN
     819        ELSE IF (nat_surf == 1) THEN
    820820        pctsrf(1, is_oce) = 0.
    821821        pctsrf(1, is_ter) = 1.
    822822        pctsrf(1, is_lic) = 0.
    823823        pctsrf(1, is_sic) = 0.
    824         else if (nat_surf == 2) THEN
     824        ELSE IF (nat_surf == 2) THEN
    825825        pctsrf(1, is_oce) = 0.
    826826        pctsrf(1, is_ter) = 0.
    827827        pctsrf(1, is_lic) = 1.
    828828        pctsrf(1, is_sic) = 0.
    829         else if (nat_surf == 3) THEN
     829        ELSE IF (nat_surf == 3) THEN
    830830        pctsrf(1, is_oce) = 0.
    831831        pctsrf(1, is_ter) = 0.
    … …  
    856856                pbl_tke(:, 2, :) = 1.e-2
    857857                PRINT *, ' pbl_tke dans lmdz1d '
    858                 if (prt_level >= 5) THEN
     858                IF (prt_level >= 5) THEN
    859859                DO nsrf = 1, 4
    860860                PRINT *, 'pbl_tke(1,:,', nsrf, ') ', pbl_tke(1, :, nsrf)
    … …  
    936936                CALL getin('iflag_physiq', iflag_physiq)
    937937
    938                 if (.not.restart) THEN
     938                IF (.NOT.restart) THEN
    939939                iflag_pbl = 5
    940940                CALL phyredem ("startphy.nc")
    … …  
    10331033                DO while(it<=it_end)
    10341034
    1035                 if (prt_level>=1) THEN
     1035                IF (prt_level>=1) THEN
    10361036        PRINT*, 'XXXXXXXXXXXXXXXXXXX ITAP,day,time=', &
    10371037        it, day, time, it_end, day_step
    … …  
    10391039        endif
    10401040        !Al1 demande de restartphy.nc
    1041         if (it==it_end) lastcall = .True.
     1041        IF (it==it_end) lastcall = .True.
    10421042
    10431043        !---------------------------------------------------------------------
    … …  
    11251125
    11261126                fcoriolis = 2. * sin(rpi * xlat / 180.) * romega
    1127         IF (forcing_radconv .or. forcing_fire) THEN
     1127        IF (forcing_radconv .OR. forcing_fire) THEN
    11281128        fcoriolis = 0.0
    11291129        dt_cooling = 0.0
    … …  
    11331133                !      PRINT*, 'calcul de fcoriolis ', fcoriolis
    11341134
    1135                 IF (forcing_toga .or. forcing_GCSSold .or. forcing_twpice            &
    1136                 .or.forcing_amma .or. forcing_type==101) THEN
     1135                IF (forcing_toga .OR. forcing_GCSSold .OR. forcing_twpice            &
     1136                .OR.forcing_amma .OR. forcing_type==101) THEN
    11371137                fcoriolis = 0.0 ; ug = 0. ; vg = 0.
    11381138                END IF
    … …  
    11491149        !on calcule dt_cooling
    11501150        do l = 1, llm
    1151         if (play(l)>=20000.) THEN
     1151        IF (play(l)>=20000.) THEN
    11521152        dt_cooling(l) = -1.5 / 86400.
    1153         elseif ((play(l)>=10000.).and.((play(l)<20000.))) THEN
     1153        elseif ((play(l)>=10000.).AND.((play(l)<20000.))) THEN
    11541154        dt_cooling(l) = -1.5 / 86400. * (play(l) - 10000.) / (10000.) - 1. / 86400. * (20000. - play(l)) / 10000. * (temp(l) - 200.)
    11551155                else
    … …  
    12171217        d_q_adv = 0.
    12181218        do l = 2, llm - 1
    1219         if (zlay(l)<=1100) THEN
     1219        IF (zlay(l)<=1100) THEN
    12201220        wwww = -0.00001 * zlay(l)
    12211221                d_t_adv(l) = -wwww * (teta(l) - teta(l + 1)) / (zlay(l) - zlay(l + 1)) / (pzero / play(l))**rkappa
    … …  
    12421242        ! pour les cas sandu et astex, on reclacule u,v,q,temp et teta dans 1D_nudge_sandu_astex.h
    12431243        ! au dessus de 700hpa, on relaxe vers les profils initiaux
    1244         if (forcing_sandu .OR. forcing_astex) THEN
     1244        IF (forcing_sandu .OR. forcing_astex) THEN
    12451245        INCLUDE "1D_nudge_sandu_astex.h"
    12461246        else
    … …  
    12581258        + d_q_nudge(1:mxcalc, :))
    12591259
    1260                 if (prt_level>=3) THEN
     1260                IF (prt_level>=3) THEN
    12611261                print *, &
    12621262                'physiq-> temp(1),dt_phys(1),d_t_adv(1),dt_cooling(1) ', &

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_scm.F90

    r5116 r5117  
    6464    !---------------------------------------------------------------------
    6565
    66     integer, parameter :: ngrid = 1
     66    INTEGER, parameter :: ngrid = 1
    6767    REAL :: zcufi = 1.
    6868    REAL :: zcvfi = 1.
    … …  
    8080
    8181    INTEGER :: kmax = llm
    82     integer llm700, nq1, nq2
     82    INTEGER llm700, nq1, nq2
    8383    INTEGER, PARAMETER :: nlev_max = 1000, nqmx = 1000
    84     real timestep, frac
    85     real height(nlev_max), tttprof(nlev_max), qtprof(nlev_max)
     84    REAL timestep, frac
     85    REAL height(nlev_max), tttprof(nlev_max), qtprof(nlev_max)
    8686    real  uprof(nlev_max), vprof(nlev_max), e12prof(nlev_max)
    8787    real  ugprof(nlev_max), vgprof(nlev_max), wfls(nlev_max)
    … …  
    9191
    9292    !        INTEGER :: forcing_type
    93     logical :: forcing_les = .FALSE.
    94     logical :: forcing_armcu = .FALSE.
    95     logical :: forcing_rico = .FALSE.
    96     logical :: forcing_radconv = .FALSE.
    97     logical :: forcing_toga = .FALSE.
    98     logical :: forcing_twpice = .FALSE.
    99     logical :: forcing_amma = .FALSE.
    100     logical :: forcing_dice = .FALSE.
    101     logical :: forcing_gabls4 = .FALSE.
    102 
    103     logical :: forcing_GCM2SCM = .FALSE.
    104     logical :: forcing_GCSSold = .FALSE.
    105     logical :: forcing_sandu = .FALSE.
    106     logical :: forcing_astex = .FALSE.
    107     logical :: forcing_fire = .FALSE.
    108     logical :: forcing_case = .FALSE.
    109     logical :: forcing_case2 = .FALSE.
    110     logical :: forcing_SCM = .FALSE.
     93    LOGICAL :: forcing_les = .FALSE.
     94    LOGICAL :: forcing_armcu = .FALSE.
     95    LOGICAL :: forcing_rico = .FALSE.
     96    LOGICAL :: forcing_radconv = .FALSE.
     97    LOGICAL :: forcing_toga = .FALSE.
     98    LOGICAL :: forcing_twpice = .FALSE.
     99    LOGICAL :: forcing_amma = .FALSE.
     100    LOGICAL :: forcing_dice = .FALSE.
     101    LOGICAL :: forcing_gabls4 = .FALSE.
     102
     103    LOGICAL :: forcing_GCM2SCM = .FALSE.
     104    LOGICAL :: forcing_GCSSold = .FALSE.
     105    LOGICAL :: forcing_sandu = .FALSE.
     106    LOGICAL :: forcing_astex = .FALSE.
     107    LOGICAL :: forcing_fire = .FALSE.
     108    LOGICAL :: forcing_case = .FALSE.
     109    LOGICAL :: forcing_case2 = .FALSE.
     110    LOGICAL :: forcing_SCM = .FALSE.
    111111
    112112    !flag forcings
    113     logical :: nudge_wind = .TRUE.
    114     logical :: nudge_thermo = .FALSE.
    115     logical :: cptadvw = .TRUE.
     113    LOGICAL :: nudge_wind = .TRUE.
     114    LOGICAL :: nudge_thermo = .FALSE.
     115    LOGICAL :: cptadvw = .TRUE.
    116116
    117117
    … …  
    129129    INTEGER :: inudge_RHT = 1
    130130    INTEGER :: inudge_UV = 2
    131     logical :: nudge(nudge_max)
     131    LOGICAL :: nudge(nudge_max)
    132132    REAL :: t_targ(llm)
    133133    REAL :: rh_targ(llm)
    … …  
    181181    !  Call to phyredem
    182182    !---------------------------------------------------------------------
    183     logical :: ok_writedem = .TRUE.
     183    LOGICAL :: ok_writedem = .TRUE.
    184184    REAL :: sollw_in = 0.
    185185    REAL :: solsw_in = 0.
    … …  
    188188    !  Call to physiq
    189189    !---------------------------------------------------------------------
    190     logical :: firstcall = .TRUE.
    191     logical :: lastcall = .FALSE.
     190    LOGICAL :: firstcall = .TRUE.
     191    LOGICAL :: lastcall = .FALSE.
    192192    REAL :: phis(1) = 0.0
    193193    REAL :: dpsrf(1)
    … …  
    196196    !  Initializations of boundary conditions
    197197    !---------------------------------------------------------------------
    198     real, allocatable :: phy_nat (:)  ! 0=ocean libre,1=land,2=glacier,3=banquise
    199     real, allocatable :: phy_alb (:)  ! Albedo land only (old value condsurf_jyg=0.3)
    200     real, allocatable :: phy_sst (:)  ! SST (will not be used; cf read_tsurf1d.F)
    201     real, allocatable :: phy_bil (:)  ! Ne sert que pour les slab_ocean
    202     real, allocatable :: phy_rug (:) ! Longueur rugosite utilisee sur land only
    203     real, allocatable :: phy_ice (:) ! Fraction de glace
    204     real, allocatable :: phy_fter(:) ! Fraction de terre
    205     real, allocatable :: phy_foce(:) ! Fraction de ocean
    206     real, allocatable :: phy_fsic(:) ! Fraction de glace
    207     real, allocatable :: phy_flic(:) ! Fraction de glace
     198    REAL, ALLOCATABLE :: phy_nat (:)  ! 0=ocean libre,1=land,2=glacier,3=banquise
     199    REAL, ALLOCATABLE :: phy_alb (:)  ! Albedo land only (old value condsurf_jyg=0.3)
     200    REAL, ALLOCATABLE :: phy_sst (:)  ! SST (will not be used; cf read_tsurf1d.F)
     201    REAL, ALLOCATABLE :: phy_bil (:)  ! Ne sert que pour les slab_ocean
     202    REAL, ALLOCATABLE :: phy_rug (:) ! Longueur rugosite utilisee sur land only
     203    REAL, ALLOCATABLE :: phy_ice (:) ! Fraction de glace
     204    REAL, ALLOCATABLE :: phy_fter(:) ! Fraction de terre
     205    REAL, ALLOCATABLE :: phy_foce(:) ! Fraction de ocean
     206    REAL, ALLOCATABLE :: phy_fsic(:) ! Fraction de glace
     207    REAL, ALLOCATABLE :: phy_flic(:) ! Fraction de glace
    208208
    209209    !---------------------------------------------------------------------
    … …  
    212212    INTEGER :: k, l, i, it = 1, mxcalc
    213213    INTEGER :: nsrf
    214     integer jcode
     214    INTEGER jcode
    215215    INTEGER read_climoz
    216216
    217217    INTEGER :: it_end ! iteration number of the last call
    218218    !Al1,plev,play,phi,phis,presnivs,
    219     integer ecrit_slab_oc !1=ecrit,-1=lit,0=no file
     219    INTEGER ecrit_slab_oc !1=ecrit,-1=lit,0=no file
    220220    data ecrit_slab_oc/-1/
    221221
    … …  
    277277    PRINT*, 'NATURE DE LA SURFACE ', nat_surf
    278278
    279     ! Initialization of the logical switch for nudging
     279    ! Initialization of the LOGICAL switch for nudging
    280280
    281281    jcode = iflag_nudge
    … …  
    315315
    316316    !      calend = 'earth_365d'
    317     if (calend == 'earth_360d') THEN
     317    IF (calend == 'earth_360d') THEN
    318318      CALL ioconf_calendar('360_day')
    319319      WRITE(*, *)'CALENDRIER CHOISI: Terrestre a 360 jours/an'
    320     else if (calend == 'earth_365d') THEN
     320    ELSE IF (calend == 'earth_365d') THEN
    321321      CALL ioconf_calendar('noleap')
    322322      WRITE(*, *)'CALENDRIER CHOISI: Terrestre a 365 jours/an'
    323     else if (calend == 'earth_366d') THEN
     323    ELSE IF (calend == 'earth_366d') THEN
    324324      CALL ioconf_calendar('all_leap')
    325325      WRITE(*, *)'CALENDRIER CHOISI: Terrestre bissextile'
    326     else if (calend == 'gregorian') THEN
     326    ELSE IF (calend == 'gregorian') THEN
    327327      stop 'gregorian calend should not be used by normal user'
    328328      CALL ioconf_calendar('gregorian') ! not to be used by normal users
    … …  
    341341    !      La date complete est dans "daytime" (l'unite est le jour).
    342342
    343     if (nday>0) THEN
     343    IF (nday>0) THEN
    344344      fnday = nday
    345345    else
    … …  
    383383    CALL init_infotrac
    384384
    385     if (nqtot>nqmx) STOP 'Augmenter nqmx dans lmdz1d.F'
     385    IF (nqtot>nqmx) STOP 'Augmenter nqmx dans lmdz1d.F'
    386386    allocate(q(llm, nqtot)) ; q(:, :) = 0.
    387387    allocate(dq(llm, nqtot))
    … …  
    404404    CALL phys_state_var_init(read_climoz)
    405405
    406     if (ngrid/=klon) THEN
     406    IF (ngrid/=klon) THEN
    407407      PRINT*, 'stop in inifis'
    408408      PRINT*, 'Probleme de dimensions :'
    … …  
    425425    !! mpl et jyg le 22/08/2012 :
    426426    !!  pour que les cas a flux de surface imposes marchent
    427     IF(.NOT.ok_flux_surf.or.max(abs(wtsurf), abs(wqsurf))>0.) THEN
     427    IF(.NOT.ok_flux_surf.OR.max(abs(wtsurf), abs(wqsurf))>0.) THEN
    428428      fsens = -wtsurf * rcpd * rho(1)
    429429      flat = -wqsurf * rlvtt * rho(1)
    … …  
    461461      do l = 1, llm
    462462        WRITE(*, *) 'l,play(l),presnivs(l): ', l, play(l), presnivs(l)
    463         if (trouve_700 .and. play(l)<=70000) THEN
     463        IF (trouve_700 .AND. play(l)<=70000) THEN
    464464          llm700 = l
    465465          print *, 'llm700,play=', llm700, play(l) / 100.
    … …  
    477477  PRINT*, 'A d_t_adv ', d_t_adv(1:20)*86400
    478478
    479   if (forcing_GCM2SCM) THEN
     479  IF (forcing_GCM2SCM) THEN
    480480  write (*, *) 'forcing_GCM2SCM not yet implemented'
    481481  stop 'in initialization'
    482   endif ! forcing_GCM2SCM
     482  ENDIF ! forcing_GCM2SCM
    483483
    484484
    … …  
    536536  ! On le met juste avant pour avoir acces a tous les champs
    537537
    538   if (ok_writedem) THEN
     538  IF (ok_writedem) THEN
    539539  !--------------------------------------------------------------------------
    540540  ! pbl_surface_init (called here) and pbl_surface_final (called by phyredem)
    … …  
    574574  PRINT*, 'avant phyredem'
    575575  pctsrf(1, :) = 0.
    576   if (nat_surf==0.) THEN
     576  IF (nat_surf==0.) THEN
    577577  pctsrf(1, is_oce) = 1.
    578578  pctsrf(1, is_ter) = 0.
    579579  pctsrf(1, is_lic) = 0.
    580580  pctsrf(1, is_sic) = 0.
    581   else if (nat_surf == 1) THEN
     581  ELSE IF (nat_surf == 1) THEN
    582582  pctsrf(1, is_oce) = 0.
    583583  pctsrf(1, is_ter) = 1.
    584584  pctsrf(1, is_lic) = 0.
    585585  pctsrf(1, is_sic) = 0.
    586   else if (nat_surf == 2) THEN
     586  ELSE IF (nat_surf == 2) THEN
    587587  pctsrf(1, is_oce) = 0.
    588588  pctsrf(1, is_ter) = 0.
    589589  pctsrf(1, is_lic) = 1.
    590590  pctsrf(1, is_sic) = 0.
    591   else if (nat_surf == 3) THEN
     591  ELSE IF (nat_surf == 3) THEN
    592592  pctsrf(1, is_oce) = 0.
    593593  pctsrf(1, is_ter) = 0.
    … …  
    693693                CALL getin('iflag_physiq', iflag_physiq)
    694694
    695                 if (.not.restart) THEN
     695                IF (.NOT.restart) THEN
    696696        iflag_pbl = 5
    697697        CALL phyredem ("startphy.nc")
    … …  
    735735                CALL phys_state_var_end
    736736                !Al1
    737                 if (restart) THEN
     737                IF (restart) THEN
    738738                PRINT*, 'CALL to restart dyn 1d'
    739739                Call dyn1deta0("start1dyn.nc", plev, play, phi, phis,presnivs, &
    … …  
    782782                do while(it<=it_end)
    783783
    784                 if (prt_level>=1) THEN
     784                IF (prt_level>=1) THEN
    785785        PRINT*, 'XXXXXXXXXXXXXXXXXXX ITAP,day,time=', &
    786786        it, day, time, it_end, day_step
    787787        PRINT*,'PAS DE TEMPS ', timestep
    788788        endif
    789         if (it==it_end) lastcall = .True.
     789        IF (it==it_end) lastcall = .True.
    790790
    791791        !---------------------------------------------------------------------
    … …  
    842842                ! Listing output for debug prt_level>=1
    843843                !---------------------------------------------------------------------
    844                 if (prt_level>=1) THEN
     844                IF (prt_level>=1) THEN
    845845                print *, ' avant physiq : -------- day time ', day, time
    846846                        WRITE(*, *) 'firstcall,lastcall,phis', &
    847847                firstcall, lastcall, phis
    848848                end if
    849                         if (prt_level>=5) THEN
     849                        IF (prt_level>=5) THEN
    850850                WRITE(*, '(a10,2a4,4a13)') 'BEFOR1 IT=', 'it', 'l', &
    851851                'presniv', 'plev','play', 'phi'
    … …  
    871871                        ! Listing output for debug
    872872                        !---------------------------------------------------------------------
    873                         if (prt_level>=5) THEN
     873                        IF (prt_level>=5) THEN
    874874                        WRITE(*, '(a11,2a4,4a13)') 'AFTER1 IT=', 'it', 'l', &
    875875                        'presniv', 'plev','play', 'phi'
    … …  
    10171017        +d_q_nudge(1:mxcalc, :))
    10181018
    1019                 if (prt_level>=3) THEN
     1019                IF (prt_level>=3) THEN
    10201020                print *, &
    10211021                'physiq-> temp(1),dt_phys(1),d_t_adv(1),dt_cooling(1) ', &
    … …  
    10721072                !   Air temperature :
    10731073                !---------------------------------------------------------------------
    1074                 if (lastcall) THEN
     1074                IF (lastcall) THEN
    10751075                PRINT*, 'Pas de temps final ', it
    10761076                CALL ju2ymds(daytime, an, mois, jour, heure)
    … …  
    10891089                enddo
    10901090
    1091                 if (ecrit_slab_oc/=-1) close(97)
     1091                IF (ecrit_slab_oc/=-1) close(97)
    10921092
    10931093        !Al1 Call to 1D equivalent of dynredem (an,mois,jour,heure ?)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_amma_read.F90

    r5116 r5117  
    66        character*80 :: fich_amma
    77! Option du cas AMMA ou on impose la discretisation verticale (Ap,Bp)
    8         integer nlev_amma, nt_amma
    9 
    10         integer year_ini_amma, day_ini_amma, mth_ini_amma
    11         real heure_ini_amma
    12         real day_ju_ini_amma   ! Julian day of amma first day
     8        INTEGER nlev_amma, nt_amma
     9
     10        INTEGER year_ini_amma, day_ini_amma, mth_ini_amma
     11        REAL heure_ini_amma
     12        REAL day_ju_ini_amma   ! Julian day of amma first day
    1313        parameter (year_ini_amma=2006)
    1414        parameter (mth_ini_amma=7)
    1515        parameter (day_ini_amma=10)  ! 10 = 10Juil2006
    1616        parameter (heure_ini_amma=0.) !0h en secondes
    17         real dt_amma
     17        REAL dt_amma
    1818        parameter (dt_amma=1800.)
    1919
    2020!profils initiaux:
    21         real, allocatable::  plev_amma(:)
    22 
    23         real, allocatable::  z_amma(:)
    24         real, allocatable::  th_amma(:),q_amma(:)
    25         real, allocatable::  u_amma(:)
    26         real, allocatable::  v_amma(:)
    27 
    28         real, allocatable::  th_ammai(:),q_ammai(:)
    29         real, allocatable::  u_ammai(:)
    30         real, allocatable::  v_ammai(:)
    31         real, allocatable::  vitw_ammai(:)
    32         real, allocatable::  ht_ammai(:)
    33         real, allocatable::  hq_ammai(:)
    34         real, allocatable::  vt_ammai(:)
    35         real, allocatable::  vq_ammai(:)
     21        REAL, ALLOCATABLE::  plev_amma(:)
     22
     23        REAL, ALLOCATABLE::  z_amma(:)
     24        REAL, ALLOCATABLE::  th_amma(:),q_amma(:)
     25        REAL, ALLOCATABLE::  u_amma(:)
     26        REAL, ALLOCATABLE::  v_amma(:)
     27
     28        REAL, ALLOCATABLE::  th_ammai(:),q_ammai(:)
     29        REAL, ALLOCATABLE::  u_ammai(:)
     30        REAL, ALLOCATABLE::  v_ammai(:)
     31        REAL, ALLOCATABLE::  vitw_ammai(:)
     32        REAL, ALLOCATABLE::  ht_ammai(:)
     33        REAL, ALLOCATABLE::  hq_ammai(:)
     34        REAL, ALLOCATABLE::  vt_ammai(:)
     35        REAL, ALLOCATABLE::  vq_ammai(:)
    3636
    3737!forcings
    38         real, allocatable::  ht_amma(:,:)
    39         real, allocatable::  hq_amma(:,:)
    40         real, allocatable::  vitw_amma(:,:)
    41         real, allocatable::  lat_amma(:),sens_amma(:)
     38        REAL, ALLOCATABLE::  ht_amma(:,:)
     39        REAL, ALLOCATABLE::  hq_amma(:,:)
     40        REAL, ALLOCATABLE::  vitw_amma(:,:)
     41        REAL, ALLOCATABLE::  lat_amma(:),sens_amma(:)
    4242
    4343!champs interpoles
    44         real, allocatable::  vitw_profamma(:)
    45         real, allocatable::  ht_profamma(:)
    46         real, allocatable::  hq_profamma(:)
    47         real lat_profamma,sens_profamma
    48         real, allocatable::  vt_profamma(:)
    49         real, allocatable::  vq_profamma(:)
    50         real, allocatable::  th_profamma(:)
    51         real, allocatable::  q_profamma(:)
    52         real, allocatable::  u_profamma(:)
    53         real, allocatable::  v_profamma(:)
     44        REAL, ALLOCATABLE::  vitw_profamma(:)
     45        REAL, ALLOCATABLE::  ht_profamma(:)
     46        REAL, ALLOCATABLE::  hq_profamma(:)
     47        REAL lat_profamma,sens_profamma
     48        REAL, ALLOCATABLE::  vt_profamma(:)
     49        REAL, ALLOCATABLE::  vq_profamma(:)
     50        REAL, ALLOCATABLE::  th_profamma(:)
     51        REAL, ALLOCATABLE::  q_profamma(:)
     52        REAL, ALLOCATABLE::  u_profamma(:)
     53        REAL, ALLOCATABLE::  v_profamma(:)
    5454
    5555
    … …  
    6565      ierr = nf90_open(fich_amma,nf90_nowrite,nid)
    6666      PRINT*,'fich_amma,nf90_nowrite,nid ',fich_amma,nf90_nowrite,nid
    67       if (ierr/=nf90_noerr) THEN
     67      IF (ierr/=nf90_noerr) THEN
    6868         WRITE(*,*) 'ERROR: GROS Pb opening forcings nc file '
    6969         WRITE(*,*) nf90_strerror(ierr)
    … …  
    178178      IMPLICIT NONE
    179179
    180       integer ntime,nlevel
    181 
    182       real zz(nlevel)
    183       real temp(nlevel),pp(nlevel)
    184       real qv(nlevel),u(nlevel)
    185       real v(nlevel)
    186       real dw(nlevel,ntime)
    187       real dt(nlevel,ntime)
    188       real dq(nlevel,ntime)
    189       real flat(ntime),sens(ntime)
    190 
    191 
    192       integer nid, ierr,rid
    193       integer nbvar3d
     180      INTEGER ntime,nlevel
     181
     182      REAL zz(nlevel)
     183      REAL temp(nlevel),pp(nlevel)
     184      REAL qv(nlevel),u(nlevel)
     185      REAL v(nlevel)
     186      REAL dw(nlevel,ntime)
     187      REAL dt(nlevel,ntime)
     188      REAL dq(nlevel,ntime)
     189      REAL flat(ntime),sens(ntime)
     190
     191
     192      INTEGER nid, ierr,rid
     193      INTEGER nbvar3d
    194194      parameter(nbvar3d=30)
    195       integer var3didin(nbvar3d)
     195      INTEGER var3didin(nbvar3d)
    196196
    197197       ierr=nf90_inq_varid(nid,"zz",var3didin(1))
    … …  
    362362
    363363! inputs:
    364         integer annee_ref
    365         integer nt_amma,nlev_amma
    366         integer year_ini_amma
    367         real day, day1,day_ini_amma,dt_amma
    368         real vitw_amma(nlev_amma,nt_amma)
    369         real ht_amma(nlev_amma,nt_amma)
    370         real hq_amma(nlev_amma,nt_amma)
    371         real lat_amma(nt_amma)
    372         real sens_amma(nt_amma)
     364        INTEGER annee_ref
     365        INTEGER nt_amma,nlev_amma
     366        INTEGER year_ini_amma
     367        REAL day, day1,day_ini_amma,dt_amma
     368        REAL vitw_amma(nlev_amma,nt_amma)
     369        REAL ht_amma(nlev_amma,nt_amma)
     370        REAL hq_amma(nlev_amma,nt_amma)
     371        REAL lat_amma(nt_amma)
     372        REAL sens_amma(nt_amma)
    373373! outputs:
    374         real vitw_prof(nlev_amma)
    375         real ht_prof(nlev_amma)
    376         real hq_prof(nlev_amma)
    377         real lat_prof,sens_prof
     374        REAL vitw_prof(nlev_amma)
     375        REAL ht_prof(nlev_amma)
     376        REAL hq_prof(nlev_amma)
     377        REAL lat_prof,sens_prof
    378378! local:
    379         integer it_amma1, it_amma2,k
    380         real timeit,time_amma1,time_amma2,frac
    381 
    382 
    383         if (forcing_type==6) THEN
     379        INTEGER it_amma1, it_amma2,k
     380        REAL timeit,time_amma1,time_amma2,frac
     381
     382
     383        IF (forcing_type==6) THEN
    384384! Check that initial day of the simulation consistent with AMMA case:
    385        if (annee_ref/=2006) THEN
     385       IF (annee_ref/=2006) THEN
    386386        PRINT*,'Pour AMMA, annee_ref doit etre 2006'
    387387        PRINT*,'Changer annee_ref dans run.def'
    388388        stop
    389389       endif
    390        if (annee_ref==2006 .and. day1<day_ini_amma) THEN
     390       IF (annee_ref==2006 .AND. day1<day_ini_amma) THEN
    391391        PRINT*,'AMMA a débuté le 10 juillet 2006',day1,day_ini_amma
    392392        PRINT*,'Changer dayref dans run.def'
    393393        stop
    394394       endif
    395        if (annee_ref==2006 .and. day1>day_ini_amma+1) THEN
     395       IF (annee_ref==2006 .AND. day1>day_ini_amma+1) THEN
    396396        PRINT*,'AMMA a fini le 11 juillet'
    397397        PRINT*,'Changer dayref ou nday dans run.def'
    … …  
    402402! Determine timestep relative to the 1st day of AMMA:
    403403!       timeit=(day-day1)*86400.
    404 !       if (annee_ref.eq.1992) THEN
     404!       if (annee_ref.EQ.1992) THEN
    405405!        timeit=(day-day_ini_toga)*86400.
    406406!       else
    … …  
    424424       time_amma2=(it_amma2-1)*dt_amma
    425425
    426        if (it_amma1 > nt_amma) THEN
     426       IF (it_amma1 > nt_amma) THEN
    427427        WRITE(*,*) 'PB-stop: day, it_amma1, it_amma2, timeit: '            &
    428428          ,day,day_ini_amma,it_amma1,it_amma2,timeit/86400.

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_cases_read.F90

    r5116 r5117  
    77        character*80 :: fich_cas
    88! Discr?tisation
    9         integer nlev_cas, nt_cas
     9        INTEGER nlev_cas, nt_cas
    1010
    1111
    … …  
    3131
    3232!profils environnementaux
    33         real, allocatable::  plev_cas(:,:)
    34 
    35         real, allocatable::  z_cas(:,:)
    36         real, allocatable::  t_cas(:,:),q_cas(:,:),rh_cas(:,:)
    37         real, allocatable::  th_cas(:,:),rv_cas(:,:)
    38         real, allocatable::  u_cas(:,:)
    39         real, allocatable::  v_cas(:,:)
     33        REAL, ALLOCATABLE::  plev_cas(:,:)
     34
     35        REAL, ALLOCATABLE::  z_cas(:,:)
     36        REAL, ALLOCATABLE::  t_cas(:,:),q_cas(:,:),rh_cas(:,:)
     37        REAL, ALLOCATABLE::  th_cas(:,:),rv_cas(:,:)
     38        REAL, ALLOCATABLE::  u_cas(:,:)
     39        REAL, ALLOCATABLE::  v_cas(:,:)
    4040
    4141!forcing
    42         real, allocatable::  ht_cas(:,:),vt_cas(:,:),dt_cas(:,:),dtrad_cas(:,:)
    43         real, allocatable::  hth_cas(:,:),vth_cas(:,:),dth_cas(:,:)
    44         real, allocatable::  hq_cas(:,:),vq_cas(:,:),dq_cas(:,:)
    45         real, allocatable::  hr_cas(:,:),vr_cas(:,:),dr_cas(:,:)
    46         real, allocatable::  hu_cas(:,:),vu_cas(:,:),du_cas(:,:)
    47         real, allocatable::  hv_cas(:,:),vv_cas(:,:),dv_cas(:,:)
    48         real, allocatable::  vitw_cas(:,:)
    49         real, allocatable::  ug_cas(:,:),vg_cas(:,:)
    50         real, allocatable::  lat_cas(:),sens_cas(:),ts_cas(:),ustar_cas(:)
    51         real, allocatable::  uw_cas(:,:),vw_cas(:,:),q1_cas(:,:),q2_cas(:,:)
     42        REAL, ALLOCATABLE::  ht_cas(:,:),vt_cas(:,:),dt_cas(:,:),dtrad_cas(:,:)
     43        REAL, ALLOCATABLE::  hth_cas(:,:),vth_cas(:,:),dth_cas(:,:)
     44        REAL, ALLOCATABLE::  hq_cas(:,:),vq_cas(:,:),dq_cas(:,:)
     45        REAL, ALLOCATABLE::  hr_cas(:,:),vr_cas(:,:),dr_cas(:,:)
     46        REAL, ALLOCATABLE::  hu_cas(:,:),vu_cas(:,:),du_cas(:,:)
     47        REAL, ALLOCATABLE::  hv_cas(:,:),vv_cas(:,:),dv_cas(:,:)
     48        REAL, ALLOCATABLE::  vitw_cas(:,:)
     49        REAL, ALLOCATABLE::  ug_cas(:,:),vg_cas(:,:)
     50        REAL, ALLOCATABLE::  lat_cas(:),sens_cas(:),ts_cas(:),ustar_cas(:)
     51        REAL, ALLOCATABLE::  uw_cas(:,:),vw_cas(:,:),q1_cas(:,:),q2_cas(:,:)
    5252
    5353!champs interpoles
    54         real, allocatable::  plev_prof_cas(:)
    55         real, allocatable::  t_prof_cas(:)
    56         real, allocatable::  q_prof_cas(:)
    57         real, allocatable::  u_prof_cas(:)
    58         real, allocatable::  v_prof_cas(:)
    59 
    60         real, allocatable::  vitw_prof_cas(:)
    61         real, allocatable::  ug_prof_cas(:)
    62         real, allocatable::  vg_prof_cas(:)
    63         real, allocatable::  ht_prof_cas(:)
    64         real, allocatable::  hq_prof_cas(:)
    65         real, allocatable::  vt_prof_cas(:)
    66         real, allocatable::  vq_prof_cas(:)
    67         real, allocatable::  dt_prof_cas(:)
    68         real, allocatable::  dtrad_prof_cas(:)
    69         real, allocatable::  dq_prof_cas(:)
    70         real, allocatable::  hu_prof_cas(:)
    71         real, allocatable::  hv_prof_cas(:)
    72         real, allocatable::  vu_prof_cas(:)
    73         real, allocatable::  vv_prof_cas(:)
    74         real, allocatable::  du_prof_cas(:)
    75         real, allocatable::  dv_prof_cas(:)
    76         real, allocatable::  uw_prof_cas(:)
    77         real, allocatable::  vw_prof_cas(:)
    78         real, allocatable::  q1_prof_cas(:)
    79         real, allocatable::  q2_prof_cas(:)
    80 
    81 
    82         real lat_prof_cas,sens_prof_cas,ts_prof_cas,ustar_prof_cas
     54        REAL, ALLOCATABLE::  plev_prof_cas(:)
     55        REAL, ALLOCATABLE::  t_prof_cas(:)
     56        REAL, ALLOCATABLE::  q_prof_cas(:)
     57        REAL, ALLOCATABLE::  u_prof_cas(:)
     58        REAL, ALLOCATABLE::  v_prof_cas(:)
     59
     60        REAL, ALLOCATABLE::  vitw_prof_cas(:)
     61        REAL, ALLOCATABLE::  ug_prof_cas(:)
     62        REAL, ALLOCATABLE::  vg_prof_cas(:)
     63        REAL, ALLOCATABLE::  ht_prof_cas(:)
     64        REAL, ALLOCATABLE::  hq_prof_cas(:)
     65        REAL, ALLOCATABLE::  vt_prof_cas(:)
     66        REAL, ALLOCATABLE::  vq_prof_cas(:)
     67        REAL, ALLOCATABLE::  dt_prof_cas(:)
     68        REAL, ALLOCATABLE::  dtrad_prof_cas(:)
     69        REAL, ALLOCATABLE::  dq_prof_cas(:)
     70        REAL, ALLOCATABLE::  hu_prof_cas(:)
     71        REAL, ALLOCATABLE::  hv_prof_cas(:)
     72        REAL, ALLOCATABLE::  vu_prof_cas(:)
     73        REAL, ALLOCATABLE::  vv_prof_cas(:)
     74        REAL, ALLOCATABLE::  du_prof_cas(:)
     75        REAL, ALLOCATABLE::  dv_prof_cas(:)
     76        REAL, ALLOCATABLE::  uw_prof_cas(:)
     77        REAL, ALLOCATABLE::  vw_prof_cas(:)
     78        REAL, ALLOCATABLE::  q1_prof_cas(:)
     79        REAL, ALLOCATABLE::  q2_prof_cas(:)
     80
     81
     82        REAL lat_prof_cas,sens_prof_cas,ts_prof_cas,ustar_prof_cas
    8383
    8484
    … …  
    9595      ierr = nf90_open(fich_cas,nf90_nowrite,nid)
    9696      PRINT*,'fich_cas,nf90_nowrite,nid ',fich_cas,nf90_nowrite,nid
    97       if (ierr/=nf90_noerr) THEN
     97      IF (ierr/=nf90_noerr) THEN
    9898         WRITE(*,*) 'ERROR: GROS Pb opening forcings nc file '
    9999         WRITE(*,*) nf90_strerror(ierr)
    … …  
    261261!program reading forcing of the case study
    262262
    263       integer ntime,nlevel
    264 
    265       real zz(nlevel,ntime)
    266       real pp(nlevel,ntime)
    267       real temp(nlevel,ntime),qv(nlevel,ntime),rh(nlevel,ntime)
    268       real theta(nlevel,ntime),rv(nlevel,ntime)
    269       real u(nlevel,ntime)
    270       real v(nlevel,ntime)
    271       real ug(nlevel,ntime)
    272       real vg(nlevel,ntime)
    273       real w(nlevel,ntime)
    274       real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
    275       real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
    276       real dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
    277       real dtrad(nlevel,ntime)
    278       real dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
    279       real dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime)
    280       real dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
    281       real flat(ntime),sens(ntime),ts(ntime),ustar(ntime)
    282       real uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
    283 
    284 
    285       integer nid, ierr,rid
    286       integer nbvar3d
     263      INTEGER ntime,nlevel
     264
     265      REAL zz(nlevel,ntime)
     266      REAL pp(nlevel,ntime)
     267      REAL temp(nlevel,ntime),qv(nlevel,ntime),rh(nlevel,ntime)
     268      REAL theta(nlevel,ntime),rv(nlevel,ntime)
     269      REAL u(nlevel,ntime)
     270      REAL v(nlevel,ntime)
     271      REAL ug(nlevel,ntime)
     272      REAL vg(nlevel,ntime)
     273      REAL w(nlevel,ntime)
     274      REAL du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
     275      REAL dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
     276      REAL dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
     277      REAL dtrad(nlevel,ntime)
     278      REAL dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
     279      REAL dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime)
     280      REAL dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
     281      REAL flat(ntime),sens(ntime),ts(ntime),ustar(ntime)
     282      REAL uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
     283
     284
     285      INTEGER nid, ierr,rid
     286      INTEGER nbvar3d
    287287      parameter(nbvar3d=39)
    288       integer var3didin(nbvar3d)
     288      INTEGER var3didin(nbvar3d)
    289289
    290290       ierr=nf90_inq_varid(nid,"zz",var3didin(1))
    … …  
    834834
    835835! inputs:
    836         integer annee_ref
    837         integer nt_cas,nlev_cas
    838         real day, day1,day_cas
    839         real ts_cas(nt_cas)
    840         real plev_cas(nlev_cas,nt_cas)
    841         real t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas)
    842         real u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
    843         real ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
    844         real vitw_cas(nlev_cas,nt_cas)
    845         real du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
    846         real dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
    847         real dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
    848         real dtrad_cas(nlev_cas,nt_cas)
    849         real dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
    850         real lat_cas(nt_cas)
    851         real sens_cas(nt_cas)
    852         real ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
    853         real q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
     836        INTEGER annee_ref
     837        INTEGER nt_cas,nlev_cas
     838        REAL day, day1,day_cas
     839        REAL ts_cas(nt_cas)
     840        REAL plev_cas(nlev_cas,nt_cas)
     841        REAL t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas)
     842        REAL u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
     843        REAL ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
     844        REAL vitw_cas(nlev_cas,nt_cas)
     845        REAL du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
     846        REAL dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
     847        REAL dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
     848        REAL dtrad_cas(nlev_cas,nt_cas)
     849        REAL dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
     850        REAL lat_cas(nt_cas)
     851        REAL sens_cas(nt_cas)
     852        REAL ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
     853        REAL q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
    854854
    855855! outputs:
    856         real plev_prof_cas(nlev_cas)
    857         real t_prof_cas(nlev_cas),q_prof_cas(nlev_cas)
    858         real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
    859         real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
    860         real vitw_prof_cas(nlev_cas)
    861         real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
    862         real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
    863         real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
    864         real dtrad_prof_cas(nlev_cas)
    865         real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
    866         real lat_prof_cas,sens_prof_cas,ts_prof_cas,ustar_prof_cas
    867         real uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
     856        REAL plev_prof_cas(nlev_cas)
     857        REAL t_prof_cas(nlev_cas),q_prof_cas(nlev_cas)
     858        REAL u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
     859        REAL ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
     860        REAL vitw_prof_cas(nlev_cas)
     861        REAL du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
     862        REAL dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
     863        REAL dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
     864        REAL dtrad_prof_cas(nlev_cas)
     865        REAL dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
     866        REAL lat_prof_cas,sens_prof_cas,ts_prof_cas,ustar_prof_cas
     867        REAL uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
    868868! local:
    869         integer it_cas1, it_cas2,k
    870         real timeit,time_cas1,time_cas2,frac
     869        INTEGER it_cas1, it_cas2,k
     870        REAL timeit,time_cas1,time_cas2,frac
    871871
    872872
    … …  
    877877! sont censes etre corrects.
    878878! A supprimer a terme (MPL 20150623)
    879 !     if ((forcing_type.eq.10).and.(1.eq.0)) THEN
     879!     if ((forcing_type.EQ.10).AND.(1.EQ.0)) THEN
    880880! Check that initial day of the simulation consistent with AMMA case:
    881 !      if (annee_ref.ne.2006) THEN
     881!      if (annee_ref.NE.2006) THEN
    882882!       PRINT*,'Pour AMMA, annee_ref doit etre 2006'
    883883!       PRINT*,'Changer annee_ref dans run.def'
    884884!       stop
    885885!      endif
    886 !      if (annee_ref.eq.2006 .and. day1.lt.day_cas) THEN
     886!      if (annee_ref.EQ.2006 .AND. day1.lt.day_cas) THEN
    887887!       PRINT*,'AMMA a debute le 10 juillet 2006',day1,day_cas
    888888!       PRINT*,'Changer dayref dans run.def'
    889889!       stop
    890890!      endif
    891 !      if (annee_ref.eq.2006 .and. day1.gt.day_cas+1) THEN
     891!      if (annee_ref.EQ.2006 .AND. day1.gt.day_cas+1) THEN
    892892!       PRINT*,'AMMA a fini le 11 juillet'
    893893!       PRINT*,'Changer dayref ou nday dans run.def'
    … …  
    898898! Determine timestep relative to the 1st day:
    899899!       timeit=(day-day1)*86400.
    900 !       if (annee_ref.eq.1992) THEN
     900!       if (annee_ref.EQ.1992) THEN
    901901!        timeit=(day-day_cas)*86400.
    902902!       else
    … …  
    929929      print *,'time_cas2=',time_cas2
    930930
    931        if (it_cas1 > nt_cas) THEN
     931       IF (it_cas1 > nt_cas) THEN
    932932        WRITE(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
    933933          ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_cases_read2.F90

    r5116 r5117  
    99  character*80 :: fich_cas
    1010  ! Discr?tisation
    11   integer nlev_cas, nt_cas
     11  INTEGER nlev_cas, nt_cas
    1212
    1313
    1414  !profils environnementaux
    15   real, allocatable::  plev_cas(:,:),plevh_cas(:)
    16   real, allocatable::  ap_cas(:),bp_cas(:)
    17 
    18   real, allocatable::  z_cas(:,:),zh_cas(:)
    19   real, allocatable::  t_cas(:,:),q_cas(:,:),qv_cas(:,:),ql_cas(:,:),qi_cas(:,:),rh_cas(:,:)
    20   real, allocatable::  th_cas(:,:),thv_cas(:,:),thl_cas(:,:),rv_cas(:,:)
    21   real, allocatable::  u_cas(:,:),v_cas(:,:),vitw_cas(:,:),omega_cas(:,:)
     15  REAL, ALLOCATABLE::  plev_cas(:,:),plevh_cas(:)
     16  REAL, ALLOCATABLE::  ap_cas(:),bp_cas(:)
     17
     18  REAL, ALLOCATABLE::  z_cas(:,:),zh_cas(:)
     19  REAL, ALLOCATABLE::  t_cas(:,:),q_cas(:,:),qv_cas(:,:),ql_cas(:,:),qi_cas(:,:),rh_cas(:,:)
     20  REAL, ALLOCATABLE::  th_cas(:,:),thv_cas(:,:),thl_cas(:,:),rv_cas(:,:)
     21  REAL, ALLOCATABLE::  u_cas(:,:),v_cas(:,:),vitw_cas(:,:),omega_cas(:,:)
    2222
    2323  !forcing
    24   real, allocatable::  ht_cas(:,:),vt_cas(:,:),dt_cas(:,:),dtrad_cas(:,:)
    25   real, allocatable::  hth_cas(:,:),vth_cas(:,:),dth_cas(:,:)
    26   real, allocatable::  hq_cas(:,:),vq_cas(:,:),dq_cas(:,:)
    27   real, allocatable::  hr_cas(:,:),vr_cas(:,:),dr_cas(:,:)
    28   real, allocatable::  hu_cas(:,:),vu_cas(:,:),du_cas(:,:)
    29   real, allocatable::  hv_cas(:,:),vv_cas(:,:),dv_cas(:,:)
    30   real, allocatable::  ug_cas(:,:),vg_cas(:,:)
    31   real, allocatable::  lat_cas(:),sens_cas(:),ts_cas(:),ps_cas(:),ustar_cas(:)
    32   real, allocatable::  uw_cas(:,:),vw_cas(:,:),q1_cas(:,:),q2_cas(:,:),tke_cas(:)
     24  REAL, ALLOCATABLE::  ht_cas(:,:),vt_cas(:,:),dt_cas(:,:),dtrad_cas(:,:)
     25  REAL, ALLOCATABLE::  hth_cas(:,:),vth_cas(:,:),dth_cas(:,:)
     26  REAL, ALLOCATABLE::  hq_cas(:,:),vq_cas(:,:),dq_cas(:,:)
     27  REAL, ALLOCATABLE::  hr_cas(:,:),vr_cas(:,:),dr_cas(:,:)
     28  REAL, ALLOCATABLE::  hu_cas(:,:),vu_cas(:,:),du_cas(:,:)
     29  REAL, ALLOCATABLE::  hv_cas(:,:),vv_cas(:,:),dv_cas(:,:)
     30  REAL, ALLOCATABLE::  ug_cas(:,:),vg_cas(:,:)
     31  REAL, ALLOCATABLE::  lat_cas(:),sens_cas(:),ts_cas(:),ps_cas(:),ustar_cas(:)
     32  REAL, ALLOCATABLE::  uw_cas(:,:),vw_cas(:,:),q1_cas(:,:),q2_cas(:,:),tke_cas(:)
    3333
    3434  !champs interpoles
    35   real, allocatable::  plev_prof_cas(:)
    36   real, allocatable::  t_prof_cas(:)
    37   real, allocatable::  theta_prof_cas(:)
    38   real, allocatable::  thl_prof_cas(:)
    39   real, allocatable::  thv_prof_cas(:)
    40   real, allocatable::  q_prof_cas(:)
    41   real, allocatable::  qv_prof_cas(:)
    42   real, allocatable::  ql_prof_cas(:)
    43   real, allocatable::  qi_prof_cas(:)
    44   real, allocatable::  rh_prof_cas(:)
    45   real, allocatable::  rv_prof_cas(:)
    46   real, allocatable::  u_prof_cas(:)
    47   real, allocatable::  v_prof_cas(:)       
    48   real, allocatable::  vitw_prof_cas(:)
    49   real, allocatable::  omega_prof_cas(:)
    50   real, allocatable::  ug_prof_cas(:)
    51   real, allocatable::  vg_prof_cas(:)
    52   real, allocatable::  ht_prof_cas(:)
    53   real, allocatable::  hth_prof_cas(:)
    54   real, allocatable::  hq_prof_cas(:)
    55   real, allocatable::  vt_prof_cas(:)
    56   real, allocatable::  vth_prof_cas(:)
    57   real, allocatable::  vq_prof_cas(:)
    58   real, allocatable::  dt_prof_cas(:)
    59   real, allocatable::  dth_prof_cas(:)
    60   real, allocatable::  dtrad_prof_cas(:)
    61   real, allocatable::  dq_prof_cas(:)
    62   real, allocatable::  hu_prof_cas(:)
    63   real, allocatable::  hv_prof_cas(:)
    64   real, allocatable::  vu_prof_cas(:)
    65   real, allocatable::  vv_prof_cas(:)
    66   real, allocatable::  du_prof_cas(:)
    67   real, allocatable::  dv_prof_cas(:)
    68   real, allocatable::  uw_prof_cas(:)
    69   real, allocatable::  vw_prof_cas(:)
    70   real, allocatable::  q1_prof_cas(:)
    71   real, allocatable::  q2_prof_cas(:)
    72 
    73 
    74   real lat_prof_cas,sens_prof_cas,ts_prof_cas,ps_prof_cas,ustar_prof_cas,tke_prof_cas
    75   real o3_cas,orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough,rugos_cas,sand_cas,clay_cas
     35  REAL, ALLOCATABLE::  plev_prof_cas(:)
     36  REAL, ALLOCATABLE::  t_prof_cas(:)
     37  REAL, ALLOCATABLE::  theta_prof_cas(:)
     38  REAL, ALLOCATABLE::  thl_prof_cas(:)
     39  REAL, ALLOCATABLE::  thv_prof_cas(:)
     40  REAL, ALLOCATABLE::  q_prof_cas(:)
     41  REAL, ALLOCATABLE::  qv_prof_cas(:)
     42  REAL, ALLOCATABLE::  ql_prof_cas(:)
     43  REAL, ALLOCATABLE::  qi_prof_cas(:)
     44  REAL, ALLOCATABLE::  rh_prof_cas(:)
     45  REAL, ALLOCATABLE::  rv_prof_cas(:)
     46  REAL, ALLOCATABLE::  u_prof_cas(:)
     47  REAL, ALLOCATABLE::  v_prof_cas(:)
     48  REAL, ALLOCATABLE::  vitw_prof_cas(:)
     49  REAL, ALLOCATABLE::  omega_prof_cas(:)
     50  REAL, ALLOCATABLE::  ug_prof_cas(:)
     51  REAL, ALLOCATABLE::  vg_prof_cas(:)
     52  REAL, ALLOCATABLE::  ht_prof_cas(:)
     53  REAL, ALLOCATABLE::  hth_prof_cas(:)
     54  REAL, ALLOCATABLE::  hq_prof_cas(:)
     55  REAL, ALLOCATABLE::  vt_prof_cas(:)
     56  REAL, ALLOCATABLE::  vth_prof_cas(:)
     57  REAL, ALLOCATABLE::  vq_prof_cas(:)
     58  REAL, ALLOCATABLE::  dt_prof_cas(:)
     59  REAL, ALLOCATABLE::  dth_prof_cas(:)
     60  REAL, ALLOCATABLE::  dtrad_prof_cas(:)
     61  REAL, ALLOCATABLE::  dq_prof_cas(:)
     62  REAL, ALLOCATABLE::  hu_prof_cas(:)
     63  REAL, ALLOCATABLE::  hv_prof_cas(:)
     64  REAL, ALLOCATABLE::  vu_prof_cas(:)
     65  REAL, ALLOCATABLE::  vv_prof_cas(:)
     66  REAL, ALLOCATABLE::  du_prof_cas(:)
     67  REAL, ALLOCATABLE::  dv_prof_cas(:)
     68  REAL, ALLOCATABLE::  uw_prof_cas(:)
     69  REAL, ALLOCATABLE::  vw_prof_cas(:)
     70  REAL, ALLOCATABLE::  q1_prof_cas(:)
     71  REAL, ALLOCATABLE::  q2_prof_cas(:)
     72
     73
     74  REAL lat_prof_cas,sens_prof_cas,ts_prof_cas,ps_prof_cas,ustar_prof_cas,tke_prof_cas
     75  REAL o3_cas,orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough,rugos_cas,sand_cas,clay_cas
    7676
    7777
    … …  
    8989    ierr = nf90_open(fich_cas,nf90_nowrite,nid)
    9090    PRINT*,'fich_cas,nf90_nowrite,nid ',fich_cas,nf90_nowrite,nid
    91     if (ierr/=nf90_noerr) THEN
     91    IF (ierr/=nf90_noerr) THEN
    9292       WRITE(*,*) 'ERROR: GROS Pb opening forcings nc file '
    9393       WRITE(*,*) nf90_strerror(ierr)
    … …  
    198198    ierr = nf90_open(fich_cas,nf90_nowrite,nid)
    199199    PRINT*,'fich_cas,nf90_nowrite,nid ',fich_cas,nf90_nowrite,nid
    200     if (ierr/=nf90_noerr) THEN
     200    IF (ierr/=nf90_noerr) THEN
    201201       WRITE(*,*) 'ERROR: GROS Pb opening forcings nc file '
    202202       WRITE(*,*) nf90_strerror(ierr)
    … …  
    326326    ierr = nf90_open(fich_cas,nf90_nowrite,nid)
    327327    PRINT*,'fich_cas,nf90_nowrite,nid ',fich_cas,nf90_nowrite,nid
    328     if (ierr/=nf90_noerr) THEN
     328    IF (ierr/=nf90_noerr) THEN
    329329       WRITE(*,*) 'ERROR: GROS Pb opening forcings nc file '
    330330       WRITE(*,*) nf90_strerror(ierr)
    … …  
    537537  IMPLICIT NONE
    538538
    539   integer ntime,nlevel
    540 
    541   real zz(nlevel,ntime)
    542   real pp(nlevel,ntime)
    543   real temp(nlevel,ntime),qv(nlevel,ntime),rh(nlevel,ntime)
    544   real theta(nlevel,ntime),rv(nlevel,ntime)
    545   real u(nlevel,ntime)
    546   real v(nlevel,ntime)
    547   real ug(nlevel,ntime)
    548   real vg(nlevel,ntime)
    549   real w(nlevel,ntime)
    550   real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
    551   real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
    552   real dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
    553   real dtrad(nlevel,ntime)
    554   real dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
    555   real dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime)
    556   real dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
    557   real flat(ntime),sens(ntime),ts(ntime),ustar(ntime)
    558   real uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime),resul(nlevel,ntime),resul1(ntime)
    559 
    560 
    561   integer nid, ierr, ierr1,ierr2,rid,i
    562   integer nbvar3d
     539  INTEGER ntime,nlevel
     540
     541  REAL zz(nlevel,ntime)
     542  REAL pp(nlevel,ntime)
     543  REAL temp(nlevel,ntime),qv(nlevel,ntime),rh(nlevel,ntime)
     544  REAL theta(nlevel,ntime),rv(nlevel,ntime)
     545  REAL u(nlevel,ntime)
     546  REAL v(nlevel,ntime)
     547  REAL ug(nlevel,ntime)
     548  REAL vg(nlevel,ntime)
     549  REAL w(nlevel,ntime)
     550  REAL du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
     551  REAL dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
     552  REAL dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
     553  REAL dtrad(nlevel,ntime)
     554  REAL dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
     555  REAL dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime)
     556  REAL dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
     557  REAL flat(ntime),sens(ntime),ts(ntime),ustar(ntime)
     558  REAL uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime),resul(nlevel,ntime),resul1(ntime)
     559
     560
     561  INTEGER nid, ierr, ierr1,ierr2,rid,i
     562  INTEGER nbvar3d
    563563  parameter(nbvar3d=39)
    564   integer var3didin(nbvar3d)
     564  INTEGER var3didin(nbvar3d)
    565565  character*5 name_var(1:nbvar3d)
    566566  data name_var/'zz','pp','temp','qv','rh','theta','rv','u','v','ug','vg','w','advu','hu','vu',&
    … …  
    652652  IMPLICIT NONE
    653653
    654   integer ntime,nlevel
    655 
    656   real ap(nlevel+1),bp(nlevel+1)
    657   real zz(nlevel,ntime),zzh(nlevel+1)
    658   real pp(nlevel,ntime),pph(nlevel+1)
    659   real temp(nlevel,ntime),qv(nlevel,ntime),ql(nlevel,ntime),qi(nlevel,ntime),rh(nlevel,ntime)
    660   real theta(nlevel,ntime),thv(nlevel,ntime),thl(nlevel,ntime),rv(nlevel,ntime)
    661   real u(nlevel,ntime),v(nlevel,ntime)
    662   real ug(nlevel,ntime),vg(nlevel,ntime)
    663   real vitw(nlevel,ntime),omega(nlevel,ntime)
    664   real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
    665   real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
    666   real dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
    667   real dtrad(nlevel,ntime)
    668   real dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
    669   real dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime),hthl(nlevel,ntime)
    670   real dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
    671   real flat(ntime),sens(ntime),ustar(ntime)
    672   real uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
    673   real ts(ntime),ps(ntime),tke(ntime)
    674   real orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas
    675   real apbp(nlevel+1),resul(nlevel,ntime),resul1(nlevel),resul2(ntime),resul3
    676 
    677 
    678   integer nid, ierr,ierr1,ierr2,rid,i
    679   integer nbvar3d
     654  INTEGER ntime,nlevel
     655
     656  REAL ap(nlevel+1),bp(nlevel+1)
     657  REAL zz(nlevel,ntime),zzh(nlevel+1)
     658  REAL pp(nlevel,ntime),pph(nlevel+1)
     659  REAL temp(nlevel,ntime),qv(nlevel,ntime),ql(nlevel,ntime),qi(nlevel,ntime),rh(nlevel,ntime)
     660  REAL theta(nlevel,ntime),thv(nlevel,ntime),thl(nlevel,ntime),rv(nlevel,ntime)
     661  REAL u(nlevel,ntime),v(nlevel,ntime)
     662  REAL ug(nlevel,ntime),vg(nlevel,ntime)
     663  REAL vitw(nlevel,ntime),omega(nlevel,ntime)
     664  REAL du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
     665  REAL dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
     666  REAL dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
     667  REAL dtrad(nlevel,ntime)
     668  REAL dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
     669  REAL dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime),hthl(nlevel,ntime)
     670  REAL dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
     671  REAL flat(ntime),sens(ntime),ustar(ntime)
     672  REAL uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
     673  REAL ts(ntime),ps(ntime),tke(ntime)
     674  REAL orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas
     675  REAL apbp(nlevel+1),resul(nlevel,ntime),resul1(nlevel),resul2(ntime),resul3
     676
     677
     678  INTEGER nid, ierr,ierr1,ierr2,rid,i
     679  INTEGER nbvar3d
    680680  parameter(nbvar3d=62)
    681   integer var3didin(nbvar3d),missing_var(nbvar3d)
     681  INTEGER var3didin(nbvar3d),missing_var(nbvar3d)
    682682  character*12 name_var(1:nbvar3d)
    683683  data name_var/'coor_par_a','coor_par_b','height_h','pressure_h',&
    … …  
    709709           endif
    710710           !-----------------------------------------------------------------------
    711         else IF(i>4.and.i<=45) then   ! Lecture des variables en (time,nlevel,lat,lon)
     711        else IF(i>4.AND.i<=45) then   ! Lecture des variables en (time,nlevel,lat,lon)
    712712           ierr = nf90_get_var(nid,var3didin(i),resul, count = [1, 1, nlevel, ntime])
    713713           print *,'read2_cas(resul), on a lu ',i,name_var(i)
    … …  
    717717           endif
    718718           !-----------------------------------------------------------------------
    719         else if (i>45.and.i<=51) then   ! Lecture des variables en (time,lat,lon)
     719        ELSE IF (i>45.AND.i<=51) then   ! Lecture des variables en (time,lat,lon)
    720720           ierr = nf90_get_var(nid,var3didin(i),resul2, count = [1, 1, ntime])
    721721           print *,'read2_cas(resul2), on a lu ',i,name_var(i)
    … …  
    821821  IMPLICIT NONE
    822822
    823   integer ntime,nlevel,k,t
    824 
    825   real ap(nlevel+1),bp(nlevel+1)
    826   real zz(nlevel,ntime),zzh(nlevel+1)
    827   real pp(nlevel,ntime),pph(nlevel+1)
     823  INTEGER ntime,nlevel,k,t
     824
     825  REAL ap(nlevel+1),bp(nlevel+1)
     826  REAL zz(nlevel,ntime),zzh(nlevel+1)
     827  REAL pp(nlevel,ntime),pph(nlevel+1)
    828828  !profils initiaux
    829   real temp0(nlevel),qv0(nlevel),ql0(nlevel),qi0(nlevel),u0(nlevel),v0(nlevel),tke0(nlevel)
    830   real pp0(nlevel)   
    831   real temp(nlevel,ntime),qv(nlevel,ntime),ql(nlevel,ntime),qi(nlevel,ntime),rh(nlevel,ntime)
    832   real theta(nlevel,ntime),thv(nlevel,ntime),thl(nlevel,ntime),rv(nlevel,ntime)
    833   real u(nlevel,ntime),v(nlevel,ntime),tke(nlevel,ntime)
    834   real ug(nlevel,ntime),vg(nlevel,ntime)
    835   real vitw(nlevel,ntime),omega(nlevel,ntime)
    836   real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
    837   real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
    838   real dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
    839   real dtrad(nlevel,ntime)
    840   real dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
    841   real dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime),hthl(nlevel,ntime)
    842   real dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
    843   real flat(ntime),sens(ntime),ustar(ntime)
    844   real uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
    845   real ts(ntime),ps(ntime)
    846   real orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas
    847   real apbp(nlevel+1),resul(nlevel,ntime),resul1(nlevel),resul2(ntime),resul3
    848 
    849 
    850   integer nid, ierr,ierr1,ierr2,rid,i
    851   integer nbvar3d
     829  REAL temp0(nlevel),qv0(nlevel),ql0(nlevel),qi0(nlevel),u0(nlevel),v0(nlevel),tke0(nlevel)
     830  REAL pp0(nlevel)
     831  REAL temp(nlevel,ntime),qv(nlevel,ntime),ql(nlevel,ntime),qi(nlevel,ntime),rh(nlevel,ntime)
     832  REAL theta(nlevel,ntime),thv(nlevel,ntime),thl(nlevel,ntime),rv(nlevel,ntime)
     833  REAL u(nlevel,ntime),v(nlevel,ntime),tke(nlevel,ntime)
     834  REAL ug(nlevel,ntime),vg(nlevel,ntime)
     835  REAL vitw(nlevel,ntime),omega(nlevel,ntime)
     836  REAL du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
     837  REAL dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
     838  REAL dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
     839  REAL dtrad(nlevel,ntime)
     840  REAL dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
     841  REAL dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime),hthl(nlevel,ntime)
     842  REAL dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
     843  REAL flat(ntime),sens(ntime),ustar(ntime)
     844  REAL uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
     845  REAL ts(ntime),ps(ntime)
     846  REAL orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas
     847  REAL apbp(nlevel+1),resul(nlevel,ntime),resul1(nlevel),resul2(ntime),resul3
     848
     849
     850  INTEGER nid, ierr,ierr1,ierr2,rid,i
     851  INTEGER nbvar3d
    852852  parameter(nbvar3d=70)
    853   integer var3didin(nbvar3d),missing_var(nbvar3d)
     853  INTEGER var3didin(nbvar3d),missing_var(nbvar3d)
    854854  character*13 name_var(1:nbvar3d)
    855855  data name_var/'coor_par_a','coor_par_b','height_h','pressure_h',&
    … …  
    884884           endif
    885885           !-----------------------------------------------------------------------
    886         else IF(i>4.and.i<=12) then   ! Lecture des variables en (time,nlevel,lat,lon)
     886        else IF(i>4.AND.i<=12) then   ! Lecture des variables en (time,nlevel,lat,lon)
    887887           ierr = nf90_get_var(nid,var3didin(i),resul1)
    888888           print *,'read2_cas(resul1), on a lu ',i,name_var(i)
    … …  
    893893           PRINT*,'Lecture de la variable #i ',i,name_var(i),minval(resul1),maxval(resul1)
    894894           !-----------------------------------------------------------------------
    895         else IF(i>12.and.i<=54) then   ! Lecture des variables en (time,nlevel,lat,lon)
     895        else IF(i>12.AND.i<=54) then   ! Lecture des variables en (time,nlevel,lat,lon)
    896896           ierr = nf90_get_var(nid,var3didin(i),resul)
    897897           print *,'read2_cas(resul), on a lu ',i,name_var(i)
    … …  
    902902           PRINT*,'Lecture de la variable #i ',i,name_var(i),minval(resul),maxval(resul)
    903903           !-----------------------------------------------------------------------
    904         else if (i>54.and.i<=65) then   ! Lecture des variables en (time,lat,lon)
     904        ELSE IF (i>54.AND.i<=65) then   ! Lecture des variables en (time,lat,lon)
    905905           ierr = nf90_get_var(nid,var3didin(i),resul2)
    906906           print *,'read2_cas(resul2), on a lu ',i,name_var(i)
    … …  
    10531053
    10541054  ! inputs:
    1055   integer annee_ref
    1056   integer nt_cas,nlev_cas
    1057   real day, day1,day_cas
    1058   real ts_cas(nt_cas),ps_cas(nt_cas)
    1059   real plev_cas(nlev_cas,nt_cas)
    1060   real t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas)
    1061   real u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
    1062   real ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
    1063   real vitw_cas(nlev_cas,nt_cas)
    1064   real du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
    1065   real dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
    1066   real dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
    1067   real dtrad_cas(nlev_cas,nt_cas)
    1068   real dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
    1069   real lat_cas(nt_cas)
    1070   real sens_cas(nt_cas)
    1071   real ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
    1072   real q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
     1055  INTEGER annee_ref
     1056  INTEGER nt_cas,nlev_cas
     1057  REAL day, day1,day_cas
     1058  REAL ts_cas(nt_cas),ps_cas(nt_cas)
     1059  REAL plev_cas(nlev_cas,nt_cas)
     1060  REAL t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas)
     1061  REAL u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
     1062  REAL ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
     1063  REAL vitw_cas(nlev_cas,nt_cas)
     1064  REAL du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
     1065  REAL dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
     1066  REAL dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
     1067  REAL dtrad_cas(nlev_cas,nt_cas)
     1068  REAL dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
     1069  REAL lat_cas(nt_cas)
     1070  REAL sens_cas(nt_cas)
     1071  REAL ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
     1072  REAL q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
    10731073
    10741074  ! outputs:
    1075   real plev_prof_cas(nlev_cas)
    1076   real t_prof_cas(nlev_cas),q_prof_cas(nlev_cas)
    1077   real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
    1078   real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
    1079   real vitw_prof_cas(nlev_cas)
    1080   real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
    1081   real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
    1082   real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
    1083   real dtrad_prof_cas(nlev_cas)
    1084   real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
    1085   real lat_prof_cas,sens_prof_cas,ts_prof_cas,ustar_prof_cas
    1086   real uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
     1075  REAL plev_prof_cas(nlev_cas)
     1076  REAL t_prof_cas(nlev_cas),q_prof_cas(nlev_cas)
     1077  REAL u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
     1078  REAL ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
     1079  REAL vitw_prof_cas(nlev_cas)
     1080  REAL du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
     1081  REAL dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
     1082  REAL dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
     1083  REAL dtrad_prof_cas(nlev_cas)
     1084  REAL dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
     1085  REAL lat_prof_cas,sens_prof_cas,ts_prof_cas,ustar_prof_cas
     1086  REAL uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
    10871087  ! local:
    1088   integer it_cas1, it_cas2,k
    1089   real timeit,time_cas1,time_cas2,frac
     1088  INTEGER it_cas1, it_cas2,k
     1089  REAL timeit,time_cas1,time_cas2,frac
    10901090
    10911091
    … …  
    10961096  ! sont censes etre corrects.
    10971097  ! A supprimer a terme (MPL 20150623)
    1098   !     if ((forcing_type.eq.10).and.(1.eq.0)) THEN
     1098  !     if ((forcing_type.EQ.10).AND.(1.EQ.0)) THEN
    10991099  ! Check that initial day of the simulation consistent with AMMA case:
    1100   !      if (annee_ref.ne.2006) THEN
     1100  !      if (annee_ref.NE.2006) THEN
    11011101  !       PRINT*,'Pour AMMA, annee_ref doit etre 2006'
    11021102  !       PRINT*,'Changer annee_ref dans run.def'
    11031103  !       stop
    11041104  !      endif
    1105   !      if (annee_ref.eq.2006 .and. day1.lt.day_cas) THEN
     1105  !      if (annee_ref.EQ.2006 .AND. day1.lt.day_cas) THEN
    11061106  !       PRINT*,'AMMA a debute le 10 juillet 2006',day1,day_cas
    11071107  !       PRINT*,'Changer dayref dans run.def'
    11081108  !       stop
    11091109  !      endif
    1110   !      if (annee_ref.eq.2006 .and. day1.gt.day_cas+1) THEN
     1110  !      if (annee_ref.EQ.2006 .AND. day1.gt.day_cas+1) THEN
    11111111  !       PRINT*,'AMMA a fini le 11 juillet'
    11121112  !       PRINT*,'Changer dayref ou nday dans run.def'
    … …  
    11171117  ! Determine timestep relative to the 1st day:
    11181118  !       timeit=(day-day1)*86400.
    1119   !       if (annee_ref.eq.1992) THEN
     1119  !       if (annee_ref.EQ.1992) THEN
    11201120  !        timeit=(day-day_cas)*86400.
    11211121  !       else
    … …  
    11451145  !print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
    11461146
    1147   if (it_cas1 > nt_cas) THEN
     1147  IF (it_cas1 > nt_cas) THEN
    11481148     WRITE(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
    11491149          ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit
    11501150     stop
    1151   endif
     1151  ENDIF
    11521152
    11531153  ! time interpolation:
    … …  
    12621262
    12631263  ! inputs:
    1264   integer annee_ref
    1265   integer nt_cas,nlev_cas
    1266   real day, day1,day_cas
    1267   real ts_cas(nt_cas),ps_cas(nt_cas)
    1268   real plev_cas(nlev_cas,nt_cas)
    1269   real t_cas(nlev_cas,nt_cas),theta_cas(nlev_cas,nt_cas),thv_cas(nlev_cas,nt_cas),thl_cas(nlev_cas,nt_cas)
    1270   real qv_cas(nlev_cas,nt_cas),ql_cas(nlev_cas,nt_cas),qi_cas(nlev_cas,nt_cas)
    1271   real u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
    1272   real ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
    1273   real vitw_cas(nlev_cas,nt_cas),omega_cas(nlev_cas,nt_cas)
    1274   real du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
    1275   real dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
    1276   real dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
    1277   real dth_cas(nlev_cas,nt_cas),hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas)
    1278   real dtrad_cas(nlev_cas,nt_cas)
    1279   real dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
    1280   real lat_cas(nt_cas),sens_cas(nt_cas),tke_cas(nt_cas)
    1281   real ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
    1282   real q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
     1264  INTEGER annee_ref
     1265  INTEGER nt_cas,nlev_cas
     1266  REAL day, day1,day_cas
     1267  REAL ts_cas(nt_cas),ps_cas(nt_cas)
     1268  REAL plev_cas(nlev_cas,nt_cas)
     1269  REAL t_cas(nlev_cas,nt_cas),theta_cas(nlev_cas,nt_cas),thv_cas(nlev_cas,nt_cas),thl_cas(nlev_cas,nt_cas)
     1270  REAL qv_cas(nlev_cas,nt_cas),ql_cas(nlev_cas,nt_cas),qi_cas(nlev_cas,nt_cas)
     1271  REAL u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
     1272  REAL ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
     1273  REAL vitw_cas(nlev_cas,nt_cas),omega_cas(nlev_cas,nt_cas)
     1274  REAL du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
     1275  REAL dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
     1276  REAL dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
     1277  REAL dth_cas(nlev_cas,nt_cas),hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas)
     1278  REAL dtrad_cas(nlev_cas,nt_cas)
     1279  REAL dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
     1280  REAL lat_cas(nt_cas),sens_cas(nt_cas),tke_cas(nt_cas)
     1281  REAL ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
     1282  REAL q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
    12831283
    12841284  ! outputs:
    1285   real plev_prof_cas(nlev_cas)
    1286   real t_prof_cas(nlev_cas),theta_prof_cas(nlev_cas),thl_prof_cas(nlev_cas),thv_prof_cas(nlev_cas)
    1287   real qv_prof_cas(nlev_cas),ql_prof_cas(nlev_cas),qi_prof_cas(nlev_cas)
    1288   real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
    1289   real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
    1290   real vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas)
    1291   real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
    1292   real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
    1293   real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
    1294   real dth_prof_cas(nlev_cas),hth_prof_cas(nlev_cas),vth_prof_cas(nlev_cas)
    1295   real dtrad_prof_cas(nlev_cas)
    1296   real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
    1297   real lat_prof_cas,sens_prof_cas,tke_prof_cas,ts_prof_cas,ustar_prof_cas
    1298   real uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
     1285  REAL plev_prof_cas(nlev_cas)
     1286  REAL t_prof_cas(nlev_cas),theta_prof_cas(nlev_cas),thl_prof_cas(nlev_cas),thv_prof_cas(nlev_cas)
     1287  REAL qv_prof_cas(nlev_cas),ql_prof_cas(nlev_cas),qi_prof_cas(nlev_cas)
     1288  REAL u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
     1289  REAL ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
     1290  REAL vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas)
     1291  REAL du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
     1292  REAL dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
     1293  REAL dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
     1294  REAL dth_prof_cas(nlev_cas),hth_prof_cas(nlev_cas),vth_prof_cas(nlev_cas)
     1295  REAL dtrad_prof_cas(nlev_cas)
     1296  REAL dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
     1297  REAL lat_prof_cas,sens_prof_cas,tke_prof_cas,ts_prof_cas,ustar_prof_cas
     1298  REAL uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
    12991299  ! local:
    1300   integer it_cas1, it_cas2,k
    1301   real timeit,time_cas1,time_cas2,frac
     1300  INTEGER it_cas1, it_cas2,k
     1301  REAL timeit,time_cas1,time_cas2,frac
    13021302
    13031303
    … …  
    13111311  ! sont censes etre corrects.
    13121312  ! A supprimer a terme (MPL 20150623)
    1313   !     if ((forcing_type.eq.10).and.(1.eq.0)) THEN
     1313  !     if ((forcing_type.EQ.10).AND.(1.EQ.0)) THEN
    13141314  ! Check that initial day of the simulation consistent with AMMA case:
    1315   !      if (annee_ref.ne.2006) THEN
     1315  !      if (annee_ref.NE.2006) THEN
    13161316  !       PRINT*,'Pour AMMA, annee_ref doit etre 2006'
    13171317  !       PRINT*,'Changer annee_ref dans run.def'
    13181318  !       stop
    13191319  !      endif
    1320   !      if (annee_ref.eq.2006 .and. day1.lt.day_cas) THEN
     1320  !      if (annee_ref.EQ.2006 .AND. day1.lt.day_cas) THEN
    13211321  !       PRINT*,'AMMA a debute le 10 juillet 2006',day1,day_cas
    13221322  !       PRINT*,'Changer dayref dans run.def'
    13231323  !       stop
    13241324  !      endif
    1325   !      if (annee_ref.eq.2006 .and. day1.gt.day_cas+1) THEN
     1325  !      if (annee_ref.EQ.2006 .AND. day1.gt.day_cas+1) THEN
    13261326  !       PRINT*,'AMMA a fini le 11 juillet'
    13271327  !       PRINT*,'Changer dayref ou nday dans run.def'
    … …  
    13321332  ! Determine timestep relative to the 1st day:
    13331333  !       timeit=(day-day1)*86400.
    1334   !       if (annee_ref.eq.1992) THEN
     1334  !       if (annee_ref.EQ.1992) THEN
    13351335  !        timeit=(day-day_cas)*86400.
    13361336  !       else
    … …  
    13611361  !print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
    13621362
    1363   if (it_cas1 > nt_cas) THEN
     1363  IF (it_cas1 > nt_cas) THEN
    13641364     WRITE(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
    13651365          ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit
    13661366     stop
    1367   endif
     1367  ENDIF
    13681368
    13691369  ! time interpolation:

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_cases_read_std.F90

    r5116 r5117  
    1010  character*80 :: fich_cas
    1111  ! Discr?tisation
    12   integer nlev_cas, nt_cas
     12  INTEGER nlev_cas, nt_cas
    1313
    1414
    1515  !profils environnementaux
    16   real, allocatable::  plev_cas(:,:),plevh_cas(:)
    17   real, allocatable::  ap_cas(:),bp_cas(:)
    18 
    19   real, allocatable::  z_cas(:,:),zh_cas(:)
    20   real, allocatable::  t_cas(:,:),q_cas(:,:),qv_cas(:,:),ql_cas(:,:),qi_cas(:,:),rh_cas(:,:)
    21   real, allocatable::  th_cas(:,:),thv_cas(:,:),thl_cas(:,:),rv_cas(:,:)
    22   real, allocatable::  u_cas(:,:),v_cas(:,:),vitw_cas(:,:),omega_cas(:,:),tke_cas(:,:)
     16  REAL, ALLOCATABLE::  plev_cas(:,:),plevh_cas(:)
     17  REAL, ALLOCATABLE::  ap_cas(:),bp_cas(:)
     18
     19  REAL, ALLOCATABLE::  z_cas(:,:),zh_cas(:)
     20  REAL, ALLOCATABLE::  t_cas(:,:),q_cas(:,:),qv_cas(:,:),ql_cas(:,:),qi_cas(:,:),rh_cas(:,:)
     21  REAL, ALLOCATABLE::  th_cas(:,:),thv_cas(:,:),thl_cas(:,:),rv_cas(:,:)
     22  REAL, ALLOCATABLE::  u_cas(:,:),v_cas(:,:),vitw_cas(:,:),omega_cas(:,:),tke_cas(:,:)
    2323
    2424  !forcing
    25   real, allocatable::  ht_cas(:,:),vt_cas(:,:),dt_cas(:,:),dtrad_cas(:,:)
    26   real, allocatable::  hth_cas(:,:),vth_cas(:,:),dth_cas(:,:)
    27   real, allocatable::  hq_cas(:,:),vq_cas(:,:),dq_cas(:,:)
    28   real, allocatable::  hr_cas(:,:),vr_cas(:,:),dr_cas(:,:)
    29   real, allocatable::  hu_cas(:,:),vu_cas(:,:),du_cas(:,:)
    30   real, allocatable::  hv_cas(:,:),vv_cas(:,:),dv_cas(:,:)
    31   real, allocatable::  ug_cas(:,:),vg_cas(:,:)
    32   real, allocatable::  temp_nudg_cas(:,:),qv_nudg_cas(:,:),u_nudg_cas(:,:),v_nudg_cas(:,:)
    33   real, allocatable::  invtau_temp_nudg_cas(:,:),invtau_qv_nudg_cas(:,:),invtau_u_nudg_cas(:,:),invtau_v_nudg_cas(:,:)
    34   real, allocatable::  lat_cas(:),sens_cas(:),tskin_cas(:),ts_cas(:),ps_cas(:),ustar_cas(:)
    35   real, allocatable::  uw_cas(:,:),vw_cas(:,:),q1_cas(:,:),q2_cas(:,:),tkes_cas(:)
     25  REAL, ALLOCATABLE::  ht_cas(:,:),vt_cas(:,:),dt_cas(:,:),dtrad_cas(:,:)
     26  REAL, ALLOCATABLE::  hth_cas(:,:),vth_cas(:,:),dth_cas(:,:)
     27  REAL, ALLOCATABLE::  hq_cas(:,:),vq_cas(:,:),dq_cas(:,:)
     28  REAL, ALLOCATABLE::  hr_cas(:,:),vr_cas(:,:),dr_cas(:,:)
     29  REAL, ALLOCATABLE::  hu_cas(:,:),vu_cas(:,:),du_cas(:,:)
     30  REAL, ALLOCATABLE::  hv_cas(:,:),vv_cas(:,:),dv_cas(:,:)
     31  REAL, ALLOCATABLE::  ug_cas(:,:),vg_cas(:,:)
     32  REAL, ALLOCATABLE::  temp_nudg_cas(:,:),qv_nudg_cas(:,:),u_nudg_cas(:,:),v_nudg_cas(:,:)
     33  REAL, ALLOCATABLE::  invtau_temp_nudg_cas(:,:),invtau_qv_nudg_cas(:,:),invtau_u_nudg_cas(:,:),invtau_v_nudg_cas(:,:)
     34  REAL, ALLOCATABLE::  lat_cas(:),sens_cas(:),tskin_cas(:),ts_cas(:),ps_cas(:),ustar_cas(:)
     35  REAL, ALLOCATABLE::  uw_cas(:,:),vw_cas(:,:),q1_cas(:,:),q2_cas(:,:),tkes_cas(:)
    3636
    3737  !champs interpoles
    38   real, allocatable::  plev_prof_cas(:)
    39   real, allocatable::  t_prof_cas(:)
    40   real, allocatable::  theta_prof_cas(:)
    41   real, allocatable::  thl_prof_cas(:)
    42   real, allocatable::  thv_prof_cas(:)
    43   real, allocatable::  q_prof_cas(:)
    44   real, allocatable::  qv_prof_cas(:)
    45   real, allocatable::  ql_prof_cas(:)
    46   real, allocatable::  qi_prof_cas(:)
    47   real, allocatable::  rh_prof_cas(:)
    48   real, allocatable::  rv_prof_cas(:)
    49   real, allocatable::  u_prof_cas(:)
    50   real, allocatable::  v_prof_cas(:)       
    51   real, allocatable::  vitw_prof_cas(:)
    52   real, allocatable::  omega_prof_cas(:)
    53   real, allocatable::  tke_prof_cas(:)
    54   real, allocatable::  ug_prof_cas(:)
    55   real, allocatable::  vg_prof_cas(:)
    56   real, allocatable::  temp_nudg_prof_cas(:),qv_nudg_prof_cas(:),u_nudg_prof_cas(:),v_nudg_prof_cas(:)
    57   real, allocatable::  invtau_temp_nudg_prof_cas(:),invtau_qv_nudg_prof_cas(:),invtau_u_nudg_prof_cas(:),invtau_v_nudg_prof_cas(:)
    58 
    59   real, allocatable::  ht_prof_cas(:)
    60   real, allocatable::  hth_prof_cas(:)
    61   real, allocatable::  hq_prof_cas(:)
    62   real, allocatable::  vt_prof_cas(:)
    63   real, allocatable::  vth_prof_cas(:)
    64   real, allocatable::  vq_prof_cas(:)
    65   real, allocatable::  dt_prof_cas(:)
    66   real, allocatable::  dth_prof_cas(:)
    67   real, allocatable::  dtrad_prof_cas(:)
    68   real, allocatable::  dq_prof_cas(:)
    69   real, allocatable::  hu_prof_cas(:)
    70   real, allocatable::  hv_prof_cas(:)
    71   real, allocatable::  vu_prof_cas(:)
    72   real, allocatable::  vv_prof_cas(:)
    73   real, allocatable::  du_prof_cas(:)
    74   real, allocatable::  dv_prof_cas(:)
    75   real, allocatable::  uw_prof_cas(:)
    76   real, allocatable::  vw_prof_cas(:)
    77   real, allocatable::  q1_prof_cas(:)
    78   real, allocatable::  q2_prof_cas(:)
    79 
    80 
    81   real o3_cas,lat_prof_cas,sens_prof_cas,ts_prof_cas,tskin_prof_cas,ps_prof_cas,ustar_prof_cas,tkes_prof_cas
    82   real orog_cas,albedo_cas,emiss_cas,q_skin_cas,mom_rough,heat_rough,rugos_cas,sand_cas,clay_cas
     38  REAL, ALLOCATABLE::  plev_prof_cas(:)
     39  REAL, ALLOCATABLE::  t_prof_cas(:)
     40  REAL, ALLOCATABLE::  theta_prof_cas(:)
     41  REAL, ALLOCATABLE::  thl_prof_cas(:)
     42  REAL, ALLOCATABLE::  thv_prof_cas(:)
     43  REAL, ALLOCATABLE::  q_prof_cas(:)
     44  REAL, ALLOCATABLE::  qv_prof_cas(:)
     45  REAL, ALLOCATABLE::  ql_prof_cas(:)
     46  REAL, ALLOCATABLE::  qi_prof_cas(:)
     47  REAL, ALLOCATABLE::  rh_prof_cas(:)
     48  REAL, ALLOCATABLE::  rv_prof_cas(:)
     49  REAL, ALLOCATABLE::  u_prof_cas(:)
     50  REAL, ALLOCATABLE::  v_prof_cas(:)
     51  REAL, ALLOCATABLE::  vitw_prof_cas(:)
     52  REAL, ALLOCATABLE::  omega_prof_cas(:)
     53  REAL, ALLOCATABLE::  tke_prof_cas(:)
     54  REAL, ALLOCATABLE::  ug_prof_cas(:)
     55  REAL, ALLOCATABLE::  vg_prof_cas(:)
     56  REAL, ALLOCATABLE::  temp_nudg_prof_cas(:),qv_nudg_prof_cas(:),u_nudg_prof_cas(:),v_nudg_prof_cas(:)
     57  REAL, ALLOCATABLE::  invtau_temp_nudg_prof_cas(:),invtau_qv_nudg_prof_cas(:),invtau_u_nudg_prof_cas(:),invtau_v_nudg_prof_cas(:)
     58
     59  REAL, ALLOCATABLE::  ht_prof_cas(:)
     60  REAL, ALLOCATABLE::  hth_prof_cas(:)
     61  REAL, ALLOCATABLE::  hq_prof_cas(:)
     62  REAL, ALLOCATABLE::  vt_prof_cas(:)
     63  REAL, ALLOCATABLE::  vth_prof_cas(:)
     64  REAL, ALLOCATABLE::  vq_prof_cas(:)
     65  REAL, ALLOCATABLE::  dt_prof_cas(:)
     66  REAL, ALLOCATABLE::  dth_prof_cas(:)
     67  REAL, ALLOCATABLE::  dtrad_prof_cas(:)
     68  REAL, ALLOCATABLE::  dq_prof_cas(:)
     69  REAL, ALLOCATABLE::  hu_prof_cas(:)
     70  REAL, ALLOCATABLE::  hv_prof_cas(:)
     71  REAL, ALLOCATABLE::  vu_prof_cas(:)
     72  REAL, ALLOCATABLE::  vv_prof_cas(:)
     73  REAL, ALLOCATABLE::  du_prof_cas(:)
     74  REAL, ALLOCATABLE::  dv_prof_cas(:)
     75  REAL, ALLOCATABLE::  uw_prof_cas(:)
     76  REAL, ALLOCATABLE::  vw_prof_cas(:)
     77  REAL, ALLOCATABLE::  q1_prof_cas(:)
     78  REAL, ALLOCATABLE::  q2_prof_cas(:)
     79
     80
     81  REAL o3_cas,lat_prof_cas,sens_prof_cas,ts_prof_cas,tskin_prof_cas,ps_prof_cas,ustar_prof_cas,tkes_prof_cas
     82  REAL orog_cas,albedo_cas,emiss_cas,q_skin_cas,mom_rough,heat_rough,rugos_cas,sand_cas,clay_cas
    8383
    8484
    … …  
    101101    ierr = nf90_open(fich_cas,nf90_nowrite,nid)
    102102    PRINT*,'fich_cas,nf90_nowrite,nid ',fich_cas,nf90_nowrite,nid
    103     if (ierr/=nf90_noerr) THEN
     103    IF (ierr/=nf90_noerr) THEN
    104104       WRITE(*,*) 'ERROR: GROS Pb opening forcings nc file '
    105105       WRITE(*,*) nf90_strerror(ierr)
    … …  
    332332    INCLUDE "compar1d.h"
    333333
    334     integer ntime,nlevel,k,t
    335 
    336     real ap(nlevel+1),bp(nlevel+1)
    337     real zz(nlevel,ntime),zzh(nlevel+1)
    338     real pp(nlevel,ntime),pph(nlevel+1)
     334    INTEGER ntime,nlevel,k,t
     335
     336    REAL ap(nlevel+1),bp(nlevel+1)
     337    REAL zz(nlevel,ntime),zzh(nlevel+1)
     338    REAL pp(nlevel,ntime),pph(nlevel+1)
    339339    !profils initiaux
    340     real temp0(nlevel),qv0(nlevel),ql0(nlevel),qi0(nlevel),u0(nlevel),v0(nlevel),tke0(nlevel)
    341     real pp0(nlevel)   
    342     real temp(nlevel,ntime),qv(nlevel,ntime),ql(nlevel,ntime),qi(nlevel,ntime),rh(nlevel,ntime)
    343     real theta(nlevel,ntime),thv(nlevel,ntime),thl(nlevel,ntime),rv(nlevel,ntime)
    344     real u(nlevel,ntime),v(nlevel,ntime),tkes(ntime)
    345     real temp_nudg(nlevel,ntime),qv_nudg(nlevel,ntime),u_nudg(nlevel,ntime),v_nudg(nlevel,ntime)
    346     real invtau_temp_nudg(nlevel,ntime),invtau_qv_nudg(nlevel,ntime),invtau_u_nudg(nlevel,ntime),invtau_v_nudg(nlevel,ntime)
    347     real ug(nlevel,ntime),vg(nlevel,ntime)
    348     real vitw(nlevel,ntime),omega(nlevel,ntime),tke(nlevel,ntime)
    349     real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
    350     real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
    351     real dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
    352     real dtrad(nlevel,ntime)
    353     real dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
    354     real dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime),hthl(nlevel,ntime)
    355     real dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
    356     real flat(ntime),sens(ntime),ustar(ntime)
    357     real uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
    358     real ts(ntime),tskin(ntime),ps(ntime)
    359     real orog_cas,albedo_cas,emiss_cas,q_skin_cas,mom_rough,heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas
    360     real apbp(nlevel+1),resul(nlevel,ntime),resul1(nlevel),resul2(ntime),resul3
    361 
    362 
    363     integer nid, ierr,ierr1,ierr2,rid,i,int_test
    364     integer nbvar3d
     340    REAL temp0(nlevel),qv0(nlevel),ql0(nlevel),qi0(nlevel),u0(nlevel),v0(nlevel),tke0(nlevel)
     341    REAL pp0(nlevel)
     342    REAL temp(nlevel,ntime),qv(nlevel,ntime),ql(nlevel,ntime),qi(nlevel,ntime),rh(nlevel,ntime)
     343    REAL theta(nlevel,ntime),thv(nlevel,ntime),thl(nlevel,ntime),rv(nlevel,ntime)
     344    REAL u(nlevel,ntime),v(nlevel,ntime),tkes(ntime)
     345    REAL temp_nudg(nlevel,ntime),qv_nudg(nlevel,ntime),u_nudg(nlevel,ntime),v_nudg(nlevel,ntime)
     346    REAL invtau_temp_nudg(nlevel,ntime),invtau_qv_nudg(nlevel,ntime),invtau_u_nudg(nlevel,ntime),invtau_v_nudg(nlevel,ntime)
     347    REAL ug(nlevel,ntime),vg(nlevel,ntime)
     348    REAL vitw(nlevel,ntime),omega(nlevel,ntime),tke(nlevel,ntime)
     349    REAL du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
     350    REAL dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
     351    REAL dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
     352    REAL dtrad(nlevel,ntime)
     353    REAL dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
     354    REAL dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime),hthl(nlevel,ntime)
     355    REAL dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
     356    REAL flat(ntime),sens(ntime),ustar(ntime)
     357    REAL uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
     358    REAL ts(ntime),tskin(ntime),ps(ntime)
     359    REAL orog_cas,albedo_cas,emiss_cas,q_skin_cas,mom_rough,heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas
     360    REAL apbp(nlevel+1),resul(nlevel,ntime),resul1(nlevel),resul2(ntime),resul3
     361
     362
     363    INTEGER nid, ierr,ierr1,ierr2,rid,i,int_test
     364    INTEGER nbvar3d
    365365    parameter(nbvar3d=78)
    366     integer var3didin(nbvar3d),missing_var(nbvar3d)
     366    INTEGER var3didin(nbvar3d),missing_var(nbvar3d)
    367367    character*13 name_var(1:nbvar3d)
    368368
    … …  
    440440          ! Activating keys depending on the presence of specific variables in cas.nc
    441441          !-----------------------------------------------------------------------
    442           if ( 1 == 1 ) THEN
     442          IF ( 1 == 1 ) THEN
    443443             ! A MODIFIER: il faudrait dire nudging_temp mais faut le declarer dans compar1d.h etc...       
    444              !           if ( name_var(i) == 'temp_nudging' .and. nint(nudging_t)==0) stop 'Nudging inconsistency temp'
    445              if ( name_var(i) == 'qv_nud' .and. nint(nudging_qv)==0) stop 'Nudging inconsistency qv'
    446              if ( name_var(i) == 'ua_nud' .and. nint(nudging_u)==0) stop 'Nudging inconsistency u'
    447              if ( name_var(i) == 'va_nud' .and. nint(nudging_v)==0) stop 'Nudging inconsistency v'
     444             !           if ( name_var(i) == 'temp_nudging' .AND. nint(nudging_t)==0) stop 'Nudging inconsistency temp'
     445             IF ( name_var(i) == 'qv_nud' .AND. nint(nudging_qv)==0) stop 'Nudging inconsistency qv'
     446             IF ( name_var(i) == 'ua_nud' .AND. nint(nudging_u)==0) stop 'Nudging inconsistency u'
     447             IF ( name_var(i) == 'va_nud' .AND. nint(nudging_v)==0) stop 'Nudging inconsistency v'
    448448          ELSE
    449449             PRINT*,'GUIDAGE : CONSISTENCY CHECK DEACTIVATED FOR TESTS of SANDU/REF'
    … …  
    464464             !  Reading 1D (N) vertical varialbes    (nlevel,lat,lon)   
    465465             !-----------------------------------------------------------------------
    466           else IF(i>4.and.i<=12) THEN
     466          else IF(i>4.AND.i<=12) THEN
    467467             ierr = nf90_get_var(nid,var3didin(i),resul1)
    468468             print *,'read_SCM(resul1), on a lu ',i,name_var(i)
    … …  
    477477             !  TBD : seems to be the same as above.
    478478             !-----------------------------------------------------------------------
    479           else IF(i>12.and.i<=61) THEN
     479          else IF(i>12.AND.i<=61) THEN
    480480             ierr = nf90_get_var(nid,var3didin(i),resul)
    481481             print *,'read_SCM(resul), on a lu ',i,name_var(i)
    … …  
    489489             !  Reading 1D time variables (time,lat,lon)
    490490             !-----------------------------------------------------------------------
    491           else if (i>62.and.i<=75) THEN
     491          ELSE IF (i>62.AND.i<=75) THEN
    492492             ierr = nf90_get_var(nid,var3didin(i),resul2)
    493493             print *,'read_SCM(resul2), on a lu ',i,name_var(i)
    … …  
    673673
    674674    ! inputs:
    675     integer annee_ref
    676     integer nt_cas,nlev_cas
    677     real day, day1,day_cas
    678     real ts_cas(nt_cas),tskin_cas(nt_cas),ps_cas(nt_cas)
    679     real plev_cas(nlev_cas,nt_cas)
    680     real t_cas(nlev_cas,nt_cas),theta_cas(nlev_cas,nt_cas)
    681     real thv_cas(nlev_cas,nt_cas), thl_cas(nlev_cas,nt_cas)
    682     real qv_cas(nlev_cas,nt_cas),ql_cas(nlev_cas,nt_cas),qi_cas(nlev_cas,nt_cas)
    683     real u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
    684     real ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
    685     real temp_nudg_cas(nlev_cas,nt_cas),qv_nudg_cas(nlev_cas,nt_cas)
    686     real u_nudg_cas(nlev_cas,nt_cas),v_nudg_cas(nlev_cas,nt_cas)
    687 
    688     real invtau_temp_nudg_cas(nlev_cas,nt_cas),invtau_qv_nudg_cas(nlev_cas,nt_cas)
    689     real invtau_u_nudg_cas(nlev_cas,nt_cas),invtau_v_nudg_cas(nlev_cas,nt_cas)
    690 
    691     real vitw_cas(nlev_cas,nt_cas),omega_cas(nlev_cas,nt_cas),tke_cas(nlev_cas,nt_cas)
    692     real du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
    693     real dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
    694     real dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
    695     real dth_cas(nlev_cas,nt_cas),hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas)
    696     real dtrad_cas(nlev_cas,nt_cas)
    697     real dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
    698     real lat_cas(nt_cas),sens_cas(nt_cas),tkes_cas(nt_cas)
    699     real ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
    700     real q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
     675    INTEGER annee_ref
     676    INTEGER nt_cas,nlev_cas
     677    REAL day, day1,day_cas
     678    REAL ts_cas(nt_cas),tskin_cas(nt_cas),ps_cas(nt_cas)
     679    REAL plev_cas(nlev_cas,nt_cas)
     680    REAL t_cas(nlev_cas,nt_cas),theta_cas(nlev_cas,nt_cas)
     681    REAL thv_cas(nlev_cas,nt_cas), thl_cas(nlev_cas,nt_cas)
     682    REAL qv_cas(nlev_cas,nt_cas),ql_cas(nlev_cas,nt_cas),qi_cas(nlev_cas,nt_cas)
     683    REAL u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
     684    REAL ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
     685    REAL temp_nudg_cas(nlev_cas,nt_cas),qv_nudg_cas(nlev_cas,nt_cas)
     686    REAL u_nudg_cas(nlev_cas,nt_cas),v_nudg_cas(nlev_cas,nt_cas)
     687
     688    REAL invtau_temp_nudg_cas(nlev_cas,nt_cas),invtau_qv_nudg_cas(nlev_cas,nt_cas)
     689    REAL invtau_u_nudg_cas(nlev_cas,nt_cas),invtau_v_nudg_cas(nlev_cas,nt_cas)
     690
     691    REAL vitw_cas(nlev_cas,nt_cas),omega_cas(nlev_cas,nt_cas),tke_cas(nlev_cas,nt_cas)
     692    REAL du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
     693    REAL dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
     694    REAL dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
     695    REAL dth_cas(nlev_cas,nt_cas),hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas)
     696    REAL dtrad_cas(nlev_cas,nt_cas)
     697    REAL dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
     698    REAL lat_cas(nt_cas),sens_cas(nt_cas),tkes_cas(nt_cas)
     699    REAL ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
     700    REAL q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
    701701
    702702    ! outputs:
    703     real plev_prof_cas(nlev_cas)
    704     real t_prof_cas(nlev_cas),theta_prof_cas(nlev_cas),thl_prof_cas(nlev_cas),thv_prof_cas(nlev_cas)
    705     real qv_prof_cas(nlev_cas),ql_prof_cas(nlev_cas),qi_prof_cas(nlev_cas)
    706     real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
    707     real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
    708     real temp_nudg_prof_cas(nlev_cas),qv_nudg_prof_cas(nlev_cas)
    709     real u_nudg_prof_cas(nlev_cas),v_nudg_prof_cas(nlev_cas)
    710 
    711     real invtau_temp_nudg_prof_cas(nlev_cas),invtau_qv_nudg_prof_cas(nlev_cas)
    712     real invtau_u_nudg_prof_cas(nlev_cas),invtau_v_nudg_prof_cas(nlev_cas)
    713 
    714     real vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas),tke_prof_cas(nlev_cas)
    715     real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
    716     real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
    717     real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
    718     real dth_prof_cas(nlev_cas),hth_prof_cas(nlev_cas),vth_prof_cas(nlev_cas)
    719     real dtrad_prof_cas(nlev_cas)
    720     real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
    721     real lat_prof_cas,sens_prof_cas,tkes_prof_cas,ts_prof_cas,tskin_prof_cas,ps_prof_cas,ustar_prof_cas
    722     real uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
     703    REAL plev_prof_cas(nlev_cas)
     704    REAL t_prof_cas(nlev_cas),theta_prof_cas(nlev_cas),thl_prof_cas(nlev_cas),thv_prof_cas(nlev_cas)
     705    REAL qv_prof_cas(nlev_cas),ql_prof_cas(nlev_cas),qi_prof_cas(nlev_cas)
     706    REAL u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
     707    REAL ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
     708    REAL temp_nudg_prof_cas(nlev_cas),qv_nudg_prof_cas(nlev_cas)
     709    REAL u_nudg_prof_cas(nlev_cas),v_nudg_prof_cas(nlev_cas)
     710
     711    REAL invtau_temp_nudg_prof_cas(nlev_cas),invtau_qv_nudg_prof_cas(nlev_cas)
     712    REAL invtau_u_nudg_prof_cas(nlev_cas),invtau_v_nudg_prof_cas(nlev_cas)
     713
     714    REAL vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas),tke_prof_cas(nlev_cas)
     715    REAL du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
     716    REAL dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
     717    REAL dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
     718    REAL dth_prof_cas(nlev_cas),hth_prof_cas(nlev_cas),vth_prof_cas(nlev_cas)
     719    REAL dtrad_prof_cas(nlev_cas)
     720    REAL dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
     721    REAL lat_prof_cas,sens_prof_cas,tkes_prof_cas,ts_prof_cas,tskin_prof_cas,ps_prof_cas,ustar_prof_cas
     722    REAL uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
    723723    ! local:
    724     integer it_cas1, it_cas2,k
    725     real timeit,time_cas1,time_cas2,frac
     724    INTEGER it_cas1, it_cas2,k
     725    REAL timeit,time_cas1,time_cas2,frac
    726726
    727727
    … …  
    735735    ! sont censes etre corrects.
    736736    ! A supprimer a terme (MPL 20150623)
    737     !     if ((forcing_type.eq.10).and.(1.eq.0)) THEN
     737    !     if ((forcing_type.EQ.10).AND.(1.EQ.0)) THEN
    738738    ! Check that initial day of the simulation consistent with AMMA case:
    739     !      if (annee_ref.ne.2006) THEN
     739    !      if (annee_ref.NE.2006) THEN
    740740    !       PRINT*,'Pour AMMA, annee_ref doit etre 2006'
    741741    !       PRINT*,'Changer annee_ref dans run.def'
    742742    !       stop
    743743    !      endif
    744     !      if (annee_ref.eq.2006 .and. day1.lt.day_cas) THEN
     744    !      if (annee_ref.EQ.2006 .AND. day1.lt.day_cas) THEN
    745745    !       PRINT*,'AMMA a debute le 10 juillet 2006',day1,day_cas
    746746    !       PRINT*,'Changer dayref dans run.def'
    747747    !       stop
    748748    !      endif
    749     !      if (annee_ref.eq.2006 .and. day1.gt.day_cas+1) THEN
     749    !      if (annee_ref.EQ.2006 .AND. day1.gt.day_cas+1) THEN
    750750    !       PRINT*,'AMMA a fini le 11 juillet'
    751751    !       PRINT*,'Changer dayref ou nday dans run.def'
    … …  
    756756    ! Determine timestep relative to the 1st day:
    757757    !       timeit=(day-day1)*86400.
    758     !       if (annee_ref.eq.1992) THEN
     758    !       if (annee_ref.EQ.1992) THEN
    759759    !        timeit=(day-day_cas)*86400.
    760760    !       else
    … …  
    785785    !     print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
    786786
    787     if (it_cas1 > nt_cas) THEN
     787    IF (it_cas1 > nt_cas) THEN
    788788       WRITE(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
    789789            ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit
    … …  
    939939    !-------------------------------------------------------------------------
    940940
    941     integer nlevmax
     941    INTEGER nlevmax
    942942    parameter (nlevmax=41)
    943     integer nlev_cas,mxcalc
     943    INTEGER nlev_cas,mxcalc
    944944    !       real play(llm), plev_prof(nlevmax)
    945945    !       real t_prof(nlevmax),q_prof(nlevmax)
    … …  
    948948    !       real hq_prof(nlevmax),vq_prof(nlevmax)
    949949
    950     real play(llm), plev(llm+1), plev_prof_cas(nlev_cas)
    951     real t_prof_cas(nlev_cas),th_prof_cas(nlev_cas),thv_prof_cas(nlev_cas),thl_prof_cas(nlev_cas)
    952     real qv_prof_cas(nlev_cas),ql_prof_cas(nlev_cas),qi_prof_cas(nlev_cas)
    953     real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
    954     real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas), vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas),tke_prof_cas(nlev_cas)
    955     real temp_nudg_prof_cas(nlev_cas),qv_nudg_prof_cas(nlev_cas)
    956     real u_nudg_prof_cas(nlev_cas),v_nudg_prof_cas(nlev_cas)
    957     real invtau_temp_nudg_prof_cas(nlev_cas),invtau_qv_nudg_prof_cas(nlev_cas)
    958     real invtau_u_nudg_prof_cas(nlev_cas),invtau_v_nudg_prof_cas(nlev_cas)
    959 
    960     real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
    961     real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
    962     real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas),dtrad_prof_cas(nlev_cas)
    963     real dth_prof_cas(nlev_cas),hth_prof_cas(nlev_cas),vth_prof_cas(nlev_cas)
    964     real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
    965 
    966     real t_mod_cas(llm),theta_mod_cas(llm),thv_mod_cas(llm),thl_mod_cas(llm)
    967     real qv_mod_cas(llm),ql_mod_cas(llm),qi_mod_cas(llm)
    968     real u_mod_cas(llm),v_mod_cas(llm)
    969     real ug_mod_cas(llm),vg_mod_cas(llm), w_mod_cas(llm),omega_mod_cas(llm),tke_mod_cas(llm+1)
    970     real temp_nudg_mod_cas(llm),qv_nudg_mod_cas(llm)
    971     real u_nudg_mod_cas(llm),v_nudg_mod_cas(llm)
    972     real invtau_temp_nudg_mod_cas(llm),invtau_qv_nudg_mod_cas(llm)
    973     real invtau_u_nudg_mod_cas(llm),invtau_v_nudg_mod_cas(llm)
    974     real du_mod_cas(llm),hu_mod_cas(llm),vu_mod_cas(llm)
    975     real dv_mod_cas(llm),hv_mod_cas(llm),vv_mod_cas(llm)
    976     real dt_mod_cas(llm),ht_mod_cas(llm),vt_mod_cas(llm),dtrad_mod_cas(llm)
    977     real dth_mod_cas(llm),hth_mod_cas(llm),vth_mod_cas(llm)
    978     real dq_mod_cas(llm),hq_mod_cas(llm),vq_mod_cas(llm)
    979 
    980     integer l,k,k1,k2
    981     real frac,frac1,frac2,fact
     950    REAL play(llm), plev(llm+1), plev_prof_cas(nlev_cas)
     951    REAL t_prof_cas(nlev_cas),th_prof_cas(nlev_cas),thv_prof_cas(nlev_cas),thl_prof_cas(nlev_cas)
     952    REAL qv_prof_cas(nlev_cas),ql_prof_cas(nlev_cas),qi_prof_cas(nlev_cas)
     953    REAL u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
     954    REAL ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas), vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas),tke_prof_cas(nlev_cas)
     955    REAL temp_nudg_prof_cas(nlev_cas),qv_nudg_prof_cas(nlev_cas)
     956    REAL u_nudg_prof_cas(nlev_cas),v_nudg_prof_cas(nlev_cas)
     957    REAL invtau_temp_nudg_prof_cas(nlev_cas),invtau_qv_nudg_prof_cas(nlev_cas)
     958    REAL invtau_u_nudg_prof_cas(nlev_cas),invtau_v_nudg_prof_cas(nlev_cas)
     959
     960    REAL du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
     961    REAL dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
     962    REAL dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas),dtrad_prof_cas(nlev_cas)
     963    REAL dth_prof_cas(nlev_cas),hth_prof_cas(nlev_cas),vth_prof_cas(nlev_cas)
     964    REAL dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
     965
     966    REAL t_mod_cas(llm),theta_mod_cas(llm),thv_mod_cas(llm),thl_mod_cas(llm)
     967    REAL qv_mod_cas(llm),ql_mod_cas(llm),qi_mod_cas(llm)
     968    REAL u_mod_cas(llm),v_mod_cas(llm)
     969    REAL ug_mod_cas(llm),vg_mod_cas(llm), w_mod_cas(llm),omega_mod_cas(llm),tke_mod_cas(llm+1)
     970    REAL temp_nudg_mod_cas(llm),qv_nudg_mod_cas(llm)
     971    REAL u_nudg_mod_cas(llm),v_nudg_mod_cas(llm)
     972    REAL invtau_temp_nudg_mod_cas(llm),invtau_qv_nudg_mod_cas(llm)
     973    REAL invtau_u_nudg_mod_cas(llm),invtau_v_nudg_mod_cas(llm)
     974    REAL du_mod_cas(llm),hu_mod_cas(llm),vu_mod_cas(llm)
     975    REAL dv_mod_cas(llm),hv_mod_cas(llm),vv_mod_cas(llm)
     976    REAL dt_mod_cas(llm),ht_mod_cas(llm),vt_mod_cas(llm),dtrad_mod_cas(llm)
     977    REAL dth_mod_cas(llm),hth_mod_cas(llm),vth_mod_cas(llm)
     978    REAL dq_mod_cas(llm),hq_mod_cas(llm),vq_mod_cas(llm)
     979
     980    INTEGER l,k,k1,k2
     981    REAL frac,frac1,frac2,fact
    982982
    983983
    … …  
    987987    do l = 1, llm
    988988
    989        if (play(l)>=plev_prof_cas(nlev_cas)) THEN
     989       IF (play(l)>=plev_prof_cas(nlev_cas)) THEN
    990990          mxcalc=l
    991991          !        print *,'debut interp2, mxcalc=',mxcalc
    … …  
    993993          k2=0
    994994
    995           if (play(l)<=plev_prof_cas(1)) THEN
     995          IF (play(l)<=plev_prof_cas(1)) THEN
    996996             do k = 1, nlev_cas-1
    997                 if (play(l)<=plev_prof_cas(k).and. play(l)>plev_prof_cas(k+1)) THEN
     997                IF (play(l)<=plev_prof_cas(k).AND. play(l)>plev_prof_cas(k+1)) THEN
    998998                   k1=k
    999999                   k2=k+1
    … …  
    10011001             enddo
    10021002
    1003              if (k1==0 .or. k2==0) THEN
     1003             IF (k1==0 .OR. k2==0) THEN
    10041004                WRITE(*,*) 'PB! k1, k2 = ',k1,k2
    10051005                WRITE(*,*) 'l,play(l) = ',l,play(l)/100
    … …  
    11611161    do l = 1, llm+1
    11621162
    1163        if (plev(l)>=plev_prof_cas(nlev_cas)) THEN
     1163       IF (plev(l)>=plev_prof_cas(nlev_cas)) THEN
    11641164          mxcalc=l
    11651165          k1=0
    11661166          k2=0
    11671167
    1168           if (plev(l)<=plev_prof_cas(1)) THEN
     1168          IF (plev(l)<=plev_prof_cas(1)) THEN
    11691169             do k = 1, nlev_cas-1
    1170                 if (plev(l)<=plev_prof_cas(k).and. plev(l)>plev_prof_cas(k+1)) THEN
     1170                IF (plev(l)<=plev_prof_cas(k).AND. plev(l)>plev_prof_cas(k+1)) THEN
    11711171                   k1=k
    11721172                   k2=k+1
    … …  
    11741174             enddo
    11751175
    1176              if (k1==0 .or. k2==0) THEN
     1176             IF (k1==0 .OR. k2==0) THEN
    11771177                WRITE(*,*) 'PB! k1, k2 = ',k1,k2
    11781178                WRITE(*,*) 'l,plev(l) = ',l,plev(l)/100

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_1DUTILS_read_interp.h

    r5116 r5117  
    99!-------------------------------------------------------------------------
    1010
    11       integer nlev_toga,nt_toga
    12       real ts_toga(nt_toga),plev_toga(nlev_toga,nt_toga)
    13       real t_toga(nlev_toga,nt_toga),q_toga(nlev_toga,nt_toga)
    14       real u_toga(nlev_toga,nt_toga),v_toga(nlev_toga,nt_toga)
    15       real w_toga(nlev_toga,nt_toga)
    16       real ht_toga(nlev_toga,nt_toga),vt_toga(nlev_toga,nt_toga)
    17       real hq_toga(nlev_toga,nt_toga),vq_toga(nlev_toga,nt_toga)
     11      INTEGER nlev_toga,nt_toga
     12      REAL ts_toga(nt_toga),plev_toga(nlev_toga,nt_toga)
     13      REAL t_toga(nlev_toga,nt_toga),q_toga(nlev_toga,nt_toga)
     14      REAL u_toga(nlev_toga,nt_toga),v_toga(nlev_toga,nt_toga)
     15      REAL w_toga(nlev_toga,nt_toga)
     16      REAL ht_toga(nlev_toga,nt_toga),vt_toga(nlev_toga,nt_toga)
     17      REAL hq_toga(nlev_toga,nt_toga),vq_toga(nlev_toga,nt_toga)
    1818      character*80 fich_toga
    1919
    20       integer k,ip
    21       real bid
    22 
    23       integer iy,im,id,ih
     20      INTEGER k,ip
     21      REAL bid
     22
     23      INTEGER iy,im,id,ih
    2424     
    25        real plev_min
     25       REAL plev_min
    2626
    2727       plev_min = 55.  ! pas de tendance de vap. d eau au-dessus de 55 hPa
    … …  
    4646         w_toga(k,ip)=w_toga(k,ip)*100./3600. ! Pa/s
    4747! no water vapour tendency above 55 hPa
    48          if (plev_toga(k,ip) .lt. plev_min) THEN
     48         IF (plev_toga(k,ip) .lt. plev_min) THEN
    4949          q_toga(k,ip) = 0.
    5050          hq_toga(k,ip) = 0.
    … …  
    7171!-------------------------------------------------------------------------
    7272
    73       integer nlev_sandu,nt_sandu
    74       real ts_sandu(nt_sandu)
     73      INTEGER nlev_sandu,nt_sandu
     74      REAL ts_sandu(nt_sandu)
    7575      character*80 fich_sandu
    7676
    77       integer ip
    78       integer iy,im,id,ih
    79 
    80       real plev_min
     77      INTEGER ip
     78      INTEGER iy,im,id,ih
     79
     80      REAL plev_min
    8181
    8282      PRINT*,'nlev_sandu',nlev_sandu
    … …  
    108108!-------------------------------------------------------------------------
    109109
    110       integer nlev_astex,nt_astex
    111       real div_astex(nt_astex),ts_astex(nt_astex),ug_astex(nt_astex)
    112       real vg_astex(nt_astex),ufa_astex(nt_astex),vfa_astex(nt_astex)
     110      INTEGER nlev_astex,nt_astex
     111      REAL div_astex(nt_astex),ts_astex(nt_astex),ug_astex(nt_astex)
     112      REAL vg_astex(nt_astex),ufa_astex(nt_astex),vfa_astex(nt_astex)
    113113      character*80 fich_astex
    114114
    115       integer ip
    116       integer iy,im,id,ih
    117 
    118        real plev_min
     115      INTEGER ip
     116      INTEGER iy,im,id,ih
     117
     118       REAL plev_min
    119119
    120120      PRINT*,'nlev_astex',nlev_astex
    … …  
    146146!program reading forcings of the TWP-ICE experiment
    147147
    148         use netcdf, ONLY: nf90_open,nf90_nowrite,nf90_noerr,nf90_strerror,nf90_inq_varid,nf90_get_var,&
     148        USE netcdf, ONLY: nf90_open,nf90_nowrite,nf90_noerr,nf90_strerror,nf90_inq_varid,nf90_get_var,&
    149149            nf90_inq_dimid,nf90_inquire_dimension
    150150
    … …  
    152152      IMPLICIT NONE
    153153
    154       integer ntime,nlevel
    155       integer l,k
     154      INTEGER ntime,nlevel
     155      INTEGER l,k
    156156      character*80 :: fich_twpice
    157157      real*8 time(ntime)
    … …  
    172172      real*8 T_srf(ntime)
    173173
    174       integer nid, ierr
    175       integer nbvar3d
     174      INTEGER nid, ierr
     175      INTEGER nbvar3d
    176176      parameter(nbvar3d=20)
    177       integer var3didin(nbvar3d)
     177      INTEGER var3didin(nbvar3d)
    178178
    179179      ierr = nf90_open(fich_twpice,nf90_nowrite,nid)
    180       if (ierr.NE.nf90_noerr) THEN
     180      IF (ierr.NE.nf90_noerr) THEN
    181181         WRITE(*,*) 'ERROR: Pb opening forcings cdf file '
    182182         WRITE(*,*) nf90_strerror(ierr)
    … …  
    492492         subroutine catchaxis(nid,ttm,llm,time,lev,ierr)
    493493
    494          use netcdf, ONLY: nf90_open,nf90_nowrite,nf90_noerr,nf90_strerror,nf90_inq_varid,nf90_get_var,&
     494         USE netcdf, ONLY: nf90_open,nf90_nowrite,nf90_noerr,nf90_strerror,nf90_inq_varid,nf90_get_var,&
    495495            nf90_inq_dimid,nf90_inquire_dimension
    496496
    497497         IMPLICIT NONE
    498          integer nid,ttm,llm
     498         INTEGER nid,ttm,llm
    499499         real*8 time(ttm)
    500500         real*8 lev(llm)
    501          integer ierr
    502 
    503          integer timevar,levvar
    504          integer timelen,levlen
    505          integer timedimin,levdimin
     501         INTEGER ierr
     502
     503         INTEGER timevar,levvar
     504         INTEGER timelen,levlen
     505         INTEGER timedimin,levdimin
    506506
    507507! Control & lecture on dimensions
    … …  
    509509         ierr=nf90_inq_dimid(nid,"time",timedimin)
    510510         ierr=nf90_inq_varid(nid,"time",timevar)
    511          if (ierr.NE.nf90_noerr) THEN
     511         IF (ierr.NE.nf90_noerr) THEN
    512512            WRITE(*,*) 'ERROR: Field <time> is missing'
    513513            stop "" 
    … …  
    517517         ierr=nf90_inq_dimid(nid,"lev",levdimin)
    518518         ierr=nf90_inq_varid(nid,"lev",levvar)
    519          if (ierr.NE.nf90_noerr) THEN
     519         IF (ierr.NE.nf90_noerr) THEN
    520520             WRITE(*,*) 'ERROR: Field <lev> is lacking'
    521521             stop ""
    … …  
    523523         ierr=nf90_inquire_dimension(nid,levdimin,len=levlen)
    524524
    525          if((timelen/=ttm).or.(levlen/=llm)) THEN
     525         IF((timelen/=ttm).OR.(levlen/=llm)) THEN
    526526            WRITE(*,*) 'ERROR: Not the good lenght for axis'
    527527            WRITE(*,*) 'longitude: ',timelen,ttm+1
    … …  
    551551!-------------------------------------------------------------------------
    552552
    553        integer nlevmax
     553       INTEGER nlevmax
    554554       parameter (nlevmax=41)
    555        integer nlev_sandu,mxcalc
     555       INTEGER nlev_sandu,mxcalc
    556556!       real play(llm), plev_prof(nlevmax)
    557557!       real t_prof(nlevmax),q_prof(nlevmax)
    … …  
    560560!       real hq_prof(nlevmax),vq_prof(nlevmax)
    561561
    562        real play(llm), plev_prof(nlev_sandu)
    563        real t_prof(nlev_sandu),thl_prof(nlev_sandu),q_prof(nlev_sandu)
    564        real u_prof(nlev_sandu),v_prof(nlev_sandu), w_prof(nlev_sandu)
    565        real omega_prof(nlev_sandu),o3mmr_prof(nlev_sandu)
    566 
    567        real t_mod(llm),thl_mod(llm),q_mod(llm)
    568        real u_mod(llm),v_mod(llm), w_mod(llm)
    569        real omega_mod(llm),o3mmr_mod(llm)
    570 
    571        integer l,k,k1,k2
    572        real frac,frac1,frac2,fact
     562       REAL play(llm), plev_prof(nlev_sandu)
     563       REAL t_prof(nlev_sandu),thl_prof(nlev_sandu),q_prof(nlev_sandu)
     564       REAL u_prof(nlev_sandu),v_prof(nlev_sandu), w_prof(nlev_sandu)
     565       REAL omega_prof(nlev_sandu),o3mmr_prof(nlev_sandu)
     566
     567       REAL t_mod(llm),thl_mod(llm),q_mod(llm)
     568       REAL u_mod(llm),v_mod(llm), w_mod(llm)
     569       REAL omega_mod(llm),o3mmr_mod(llm)
     570
     571       INTEGER l,k,k1,k2
     572       REAL frac,frac1,frac2,fact
    573573
    574574       do l = 1, llm
    575575
    576         if (play(l).ge.plev_prof(nlev_sandu)) THEN
     576        IF (play(l).ge.plev_prof(nlev_sandu)) THEN
    577577        mxcalc=l
    578578         k1=0
    579579         k2=0
    580580
    581          if (play(l).le.plev_prof(1)) THEN
     581         IF (play(l).le.plev_prof(1)) THEN
    582582         do k = 1, nlev_sandu-1
    583           if (play(l).le.plev_prof(k).and. play(l).gt.plev_prof(k+1)) THEN
     583          IF (play(l).le.plev_prof(k).AND. play(l).gt.plev_prof(k+1)) THEN
    584584            k1=k
    585585            k2=k+1
    … …  
    587587         enddo
    588588
    589          if (k1.eq.0 .or. k2.eq.0) THEN
     589         IF (k1.EQ.0 .OR. k2.EQ.0) THEN
    590590          WRITE(*,*) 'PB! k1, k2 = ',k1,k2
    591591          WRITE(*,*) 'l,play(l) = ',l,play(l)/100
    … …  
    663663!-------------------------------------------------------------------------
    664664
    665        integer nlevmax
     665       INTEGER nlevmax
    666666       parameter (nlevmax=41)
    667        integer nlev_astex,mxcalc
     667       INTEGER nlev_astex,mxcalc
    668668!       real play(llm), plev_prof(nlevmax)
    669669!       real t_prof(nlevmax),qv_prof(nlevmax)
    … …  
    672672!       real hq_prof(nlevmax),vq_prof(nlevmax)
    673673
    674        real play(llm), plev_prof(nlev_astex)
    675        real t_prof(nlev_astex),thl_prof(nlev_astex),qv_prof(nlev_astex)
    676        real u_prof(nlev_astex),v_prof(nlev_astex), w_prof(nlev_astex)
    677        real o3mmr_prof(nlev_astex),ql_prof(nlev_astex)
    678        real qt_prof(nlev_astex),tke_prof(nlev_astex)
    679 
    680        real t_mod(llm),thl_mod(llm),qv_mod(llm)
    681        real u_mod(llm),v_mod(llm), w_mod(llm),tke_mod(llm)
    682        real o3mmr_mod(llm),ql_mod(llm),qt_mod(llm)
    683 
    684        integer l,k,k1,k2
    685        real frac,frac1,frac2,fact
     674       REAL play(llm), plev_prof(nlev_astex)
     675       REAL t_prof(nlev_astex),thl_prof(nlev_astex),qv_prof(nlev_astex)
     676       REAL u_prof(nlev_astex),v_prof(nlev_astex), w_prof(nlev_astex)
     677       REAL o3mmr_prof(nlev_astex),ql_prof(nlev_astex)
     678       REAL qt_prof(nlev_astex),tke_prof(nlev_astex)
     679
     680       REAL t_mod(llm),thl_mod(llm),qv_mod(llm)
     681       REAL u_mod(llm),v_mod(llm), w_mod(llm),tke_mod(llm)
     682       REAL o3mmr_mod(llm),ql_mod(llm),qt_mod(llm)
     683
     684       INTEGER l,k,k1,k2
     685       REAL frac,frac1,frac2,fact
    686686
    687687       do l = 1, llm
    688688
    689         if (play(l).ge.plev_prof(nlev_astex)) THEN
     689        IF (play(l).ge.plev_prof(nlev_astex)) THEN
    690690        mxcalc=l
    691691         k1=0
    692692         k2=0
    693693
    694          if (play(l).le.plev_prof(1)) THEN
     694         IF (play(l).le.plev_prof(1)) THEN
    695695         do k = 1, nlev_astex-1
    696           if (play(l).le.plev_prof(k).and. play(l).gt.plev_prof(k+1)) THEN
     696          IF (play(l).le.plev_prof(k).AND. play(l).gt.plev_prof(k+1)) THEN
    697697            k1=k
    698698            k2=k+1
    … …  
    700700         enddo
    701701
    702          if (k1.eq.0 .or. k2.eq.0) THEN
     702         IF (k1.EQ.0 .OR. k2.EQ.0) THEN
    703703          WRITE(*,*) 'PB! k1, k2 = ',k1,k2
    704704          WRITE(*,*) 'l,play(l) = ',l,play(l)/100
    … …  
    780780
    781781
    782       integer nlev_rico
    783       real ts_rico,ps_rico
    784       real t_rico(llm),q_rico(llm)
    785       real u_rico(llm),v_rico(llm)
    786       real w_rico(llm)
    787       real dth_dyn(llm)
    788       real dqh_dyn(llm)
     782      INTEGER nlev_rico
     783      REAL ts_rico,ps_rico
     784      REAL t_rico(llm),q_rico(llm)
     785      REAL u_rico(llm),v_rico(llm)
     786      REAL w_rico(llm)
     787      REAL dth_dyn(llm)
     788      REAL dqh_dyn(llm)
    789789     
    790790
    791       real play(llm),zlay(llm)
     791      REAL play(llm),zlay(llm)
    792792     
    793793
    794       real prico(nlev_rico),zrico(nlev_rico)
     794      REAL prico(nlev_rico),zrico(nlev_rico)
    795795
    796796      character*80 fich_rico
    797797
    798       integer k,l
     798      INTEGER k,l
    799799
    800800     
    … …  
    827827        PRINT*,k,zlay(k)
    828828        ! U
    829         IF(0 < zlay(k) .and. zlay(k) < 4000) THEN
     829        IF(0 < zlay(k) .AND. zlay(k) < 4000) THEN
    830830          u_rico(k)=-9.9 + (-1.9 + 9.9)*zlay(k)/4000
    831         elseif(4000 < zlay(k) .and. zlay(k) < 12000) THEN
     831        elseif(4000 < zlay(k) .AND. zlay(k) < 12000) THEN
    832832       u_rico(k)=  -1.9 + (30.0 + 1.9) /                                   &
    833833     &          (12000 - 4000) * (zlay(k) - 4000)
    834         elseif(12000 < zlay(k) .and. zlay(k) < 13000) THEN
     834        elseif(12000 < zlay(k) .AND. zlay(k) < 13000) THEN
    835835          u_rico(k)=30.0
    836         elseif(13000 < zlay(k) .and. zlay(k) < 20000) THEN
     836        elseif(13000 < zlay(k) .AND. zlay(k) < 20000) THEN
    837837          u_rico(k)=30.0 - (30.0) /                                        &
    838838     & (20000 - 13000) * (zlay(k) - 13000)
    … …  
    842842
    843843!Q_v
    844         IF(0 < zlay(k) .and. zlay(k) < 740) THEN
     844        IF(0 < zlay(k) .AND. zlay(k) < 740) THEN
    845845          q_rico(k)=16.0 + (13.8 - 16.0) / (740) * zlay(k)
    846         elseif(740 < zlay(k) .and. zlay(k) < 3260) THEN
     846        elseif(740 < zlay(k) .AND. zlay(k) < 3260) THEN
    847847          q_rico(k)=13.8 + (2.4 - 13.8) /                                   &
    848848     &          (3260 - 740) * (zlay(k) - 740)
    849         elseif(3260 < zlay(k) .and. zlay(k) < 4000) THEN
     849        elseif(3260 < zlay(k) .AND. zlay(k) < 4000) THEN
    850850          q_rico(k)=2.4 + (1.8 - 2.4) /                                    &
    851851     &               (4000 - 3260) * (zlay(k) - 3260)
    852         elseif(4000 < zlay(k) .and. zlay(k) < 9000) THEN
     852        elseif(4000 < zlay(k) .AND. zlay(k) < 9000) THEN
    853853          q_rico(k)=1.8 + (0 - 1.8) /                                      &
    854854     &             (9000 - 4000) * (zlay(k) - 4000)
    … …  
    858858
    859859!T
    860         IF(0 < zlay(k) .and. zlay(k) < 740) THEN
     860        IF(0 < zlay(k) .AND. zlay(k) < 740) THEN
    861861          t_rico(k)=299.2 + (292.0 - 299.2) / (740) * zlay(k)
    862         elseif(740 < zlay(k) .and. zlay(k) < 4000) THEN
     862        elseif(740 < zlay(k) .AND. zlay(k) < 4000) THEN
    863863          t_rico(k)=292.0 + (278.0 - 292.0) /                              &                       
    864864     &       (4000 - 740) * (zlay(k) - 740)
    865         elseif(4000 < zlay(k) .and. zlay(k) < 15000) THEN
     865        elseif(4000 < zlay(k) .AND. zlay(k) < 15000) THEN
    866866          t_rico(k)=278.0 + (203.0 - 278.0) /                              &
    867867     &       (15000 - 4000) * (zlay(k) - 4000)
    868         elseif(15000 < zlay(k) .and. zlay(k) < 17500) THEN
     868        elseif(15000 < zlay(k) .AND. zlay(k) < 17500) THEN
    869869          t_rico(k)=203.0 + (194.0 - 203.0) /                              &
    870870     &       (17500 - 15000)* (zlay(k) - 15000)
    871         elseif(17500 < zlay(k) .and. zlay(k) < 20000) THEN
     871        elseif(17500 < zlay(k) .AND. zlay(k) < 20000) THEN
    872872          t_rico(k)=194.0 + (206.0 - 194.0) /                              &
    873873     &       (20000 - 17500)* (zlay(k) - 17500)
    874         elseif(20000 < zlay(k) .and. zlay(k) < 60000) THEN
     874        elseif(20000 < zlay(k) .AND. zlay(k) < 60000) THEN
    875875          t_rico(k)=206.0 + (270.0 - 206.0) /                              &
    876876     &        (60000 - 20000)* (zlay(k) - 20000)
    … …  
    878878
    879879! W
    880         IF(0 < zlay(k) .and. zlay(k) < 2260 ) THEN
     880        IF(0 < zlay(k) .AND. zlay(k) < 2260 ) THEN
    881881          w_rico(k)=- (0.005/2260) * zlay(k)
    882         elseif(2260 < zlay(k) .and. zlay(k) < 4000 ) THEN
     882        elseif(2260 < zlay(k) .AND. zlay(k) < 4000 ) THEN
    883883          w_rico(k)=- 0.005
    884         elseif(4000 < zlay(k) .and. zlay(k) < 5000 ) THEN
     884        elseif(4000 < zlay(k) .AND. zlay(k) < 5000 ) THEN
    885885       w_rico(k)=- 0.005 + (0.005/ (5000 - 4000)) * (zlay(k) - 4000)
    886886        else
    … …  
    889889
    890890! dThrz+dTsw0+dTlw0
    891         IF(0 < zlay(k) .and. zlay(k) < 4000) THEN
     891        IF(0 < zlay(k) .AND. zlay(k) < 4000) THEN
    892892          dth_dyn(k)=- 2.51 / 86400 + (-2.18 + 2.51 )/                     &
    893893     &               (86400*4000) * zlay(k)
    894         elseif(4000 < zlay(k) .and. zlay(k) < 5000) THEN
     894        elseif(4000 < zlay(k) .AND. zlay(k) < 5000) THEN
    895895          dth_dyn(k)=- 2.18 / 86400 + ( 2.18 ) /                           &
    896896     &           (86400*(5000 - 4000)) * (zlay(k) - 4000)
    … …  
    899899        endif
    900900! dQhrz
    901         IF(0 < zlay(k) .and. zlay(k) < 3000) THEN
     901        IF(0 < zlay(k) .AND. zlay(k) < 3000) THEN
    902902          dqh_dyn(k)=-1.0 / 86400 + (0.345 + 1.0)/                         &
    903903     &                    (86400*3000) * (zlay(k))
    904         elseif(3000 < zlay(k) .and. zlay(k) < 4000) THEN
     904        elseif(3000 < zlay(k) .AND. zlay(k) < 4000) THEN
    905905          dqh_dyn(k)=0.345 / 86400
    906         elseif(4000 < zlay(k) .and. zlay(k) < 5000) THEN
     906        elseif(4000 < zlay(k) .AND. zlay(k) < 5000) THEN
    907907          dqh_dyn(k)=0.345 / 86400 +                                       &
    908908     &   (-0.345)/(86400 * (5000 - 4000)) * (zlay(k)-4000)
    … …  
    913913!?        IF(play(k)>6e4) THEN
    914914!?          ratqs0(1,k)=ratqsbas*(plev(1)-play(k))/(plev(1)-6e4)
    915 !?        elseif((play(k)>3e4).and.(play(k)<6e4)) THEN
     915!?        elseif((play(k)>3e4).AND.(play(k)<6e4)) THEN
    916916!?          ratqs0(1,k)=ratqsbas+(ratqshaut-ratqsbas)&
    917917!?                          *(6e4-play(k))/(6e4-3e4)
    … …  
    946946!---------------------------------------------------------------------------------------
    947947! inputs:
    948         integer annee_ref
    949         integer nt_sandu,nlev_sandu
    950         integer year_ini_sandu
    951         real day, day1,day_ini_sandu,dt_sandu
    952         real ts_sandu(nt_sandu)
     948        INTEGER annee_ref
     949        INTEGER nt_sandu,nlev_sandu
     950        INTEGER year_ini_sandu
     951        REAL day, day1,day_ini_sandu,dt_sandu
     952        REAL ts_sandu(nt_sandu)
    953953! outputs:
    954         real ts_prof
     954        REAL ts_prof
    955955! local:
    956         integer it_sandu1, it_sandu2
    957         real timeit,time_sandu1,time_sandu2,frac
     956        INTEGER it_sandu1, it_sandu2
     957        REAL timeit,time_sandu1,time_sandu2,frac
    958958! Check that initial day of the simulation consistent with SANDU period:
    959        if (annee_ref.ne.2006 ) THEN
     959       IF (annee_ref.NE.2006 ) THEN
    960960        PRINT*,'Pour SANDUREF, annee_ref doit etre 2006 '
    961961        PRINT*,'Changer annee_ref dans run.def'
    962962        stop
    963963       endif
    964 !      if (annee_ref.eq.2006 .and. day1.lt.day_ini_sandu) THEN
     964!      if (annee_ref.EQ.2006 .AND. day1.lt.day_ini_sandu) THEN
    965965!       PRINT*,'SANDUREF debute le 15 Juillet 2006 (jour julien=196)'
    966966!       PRINT*,'Changer dayref dans run.def'
    … …  
    970970! Determine timestep relative to the 1st day of TOGA-COARE:
    971971!       timeit=(day-day1)*86400.
    972 !       if (annee_ref.eq.1992) THEN
     972!       if (annee_ref.EQ.1992) THEN
    973973!        timeit=(day-day_ini_sandu)*86400.
    974974!       else
    … …  
    986986     &          it_sandu1,it_sandu2,time_sandu1,time_sandu2
    987987
    988        if (it_sandu1 .ge. nt_sandu) THEN
     988       IF (it_sandu1 .ge. nt_sandu) THEN
    989989        WRITE(*,*) 'PB-stop: day, it_sandu1, it_sandu2, timeit: '          &
    990990     &        ,day,it_sandu1,it_sandu2,timeit/86400.
    … …  
    10161016!-------------------------------------------------------------------------
    10171017
    1018       integer nlev_armcu,nt_armcu
    1019       real sens(nt_armcu),flat(nt_armcu)
    1020       real adv_theta(nt_armcu),rad_theta(nt_armcu),adv_qt(nt_armcu)
     1018      INTEGER nlev_armcu,nt_armcu
     1019      REAL sens(nt_armcu),flat(nt_armcu)
     1020      REAL adv_theta(nt_armcu),rad_theta(nt_armcu),adv_qt(nt_armcu)
    10211021      character*80 fich_armcu
    10221022
    1023       integer ip
    1024 
    1025       integer iy,im,id,ih,in
     1023      INTEGER ip
     1024
     1025      INTEGER iy,im,id,ih,in
    10261026
    10271027      PRINT*,'nlev_armcu',nlev_armcu
    … …  
    10591059!-------------------------------------------------------------------------
    10601060 
    1061        integer nlevmax
     1061       INTEGER nlevmax
    10621062       parameter (nlevmax=41)
    1063        integer nlev_toga,mxcalc
     1063       INTEGER nlev_toga,mxcalc
    10641064!       real play(llm), plev_prof(nlevmax)
    10651065!       real t_prof(nlevmax),q_prof(nlevmax)
    … …  
    10681068!       real hq_prof(nlevmax),vq_prof(nlevmax)
    10691069 
    1070        real play(llm), plev_prof(nlev_toga)
    1071        real t_prof(nlev_toga),q_prof(nlev_toga)
    1072        real u_prof(nlev_toga),v_prof(nlev_toga), w_prof(nlev_toga)
    1073        real ht_prof(nlev_toga),vt_prof(nlev_toga)
    1074        real hq_prof(nlev_toga),vq_prof(nlev_toga)
    1075  
    1076        real t_mod(llm),q_mod(llm)
    1077        real u_mod(llm),v_mod(llm), w_mod(llm)
    1078        real ht_mod(llm),vt_mod(llm)
    1079        real hq_mod(llm),vq_mod(llm)
    1080  
    1081        integer l,k,k1,k2
    1082        real frac,frac1,frac2,fact
     1070       REAL play(llm), plev_prof(nlev_toga)
     1071       REAL t_prof(nlev_toga),q_prof(nlev_toga)
     1072       REAL u_prof(nlev_toga),v_prof(nlev_toga), w_prof(nlev_toga)
     1073       REAL ht_prof(nlev_toga),vt_prof(nlev_toga)
     1074       REAL hq_prof(nlev_toga),vq_prof(nlev_toga)
     1075 
     1076       REAL t_mod(llm),q_mod(llm)
     1077       REAL u_mod(llm),v_mod(llm), w_mod(llm)
     1078       REAL ht_mod(llm),vt_mod(llm)
     1079       REAL hq_mod(llm),vq_mod(llm)
     1080 
     1081       INTEGER l,k,k1,k2
     1082       REAL frac,frac1,frac2,fact
    10831083 
    10841084       do l = 1, llm
    10851085
    1086         if (play(l).ge.plev_prof(nlev_toga)) THEN
     1086        IF (play(l).ge.plev_prof(nlev_toga)) THEN
    10871087        mxcalc=l
    10881088         k1=0
    10891089         k2=0
    10901090
    1091          if (play(l).le.plev_prof(1)) THEN
     1091         IF (play(l).le.plev_prof(1)) THEN
    10921092         do k = 1, nlev_toga-1
    1093           if (play(l).le.plev_prof(k).and. play(l).gt.plev_prof(k+1)) THEN
     1093          IF (play(l).le.plev_prof(k).AND. play(l).gt.plev_prof(k+1)) THEN
    10941094            k1=k
    10951095            k2=k+1
    … …  
    10971097         enddo
    10981098
    1099          if (k1.eq.0 .or. k2.eq.0) THEN
     1099         IF (k1.EQ.0 .OR. k2.EQ.0) THEN
    11001100          WRITE(*,*) 'PB! k1, k2 = ',k1,k2
    11011101          WRITE(*,*) 'l,play(l) = ',l,play(l)/100
    … …  
    11791179!-------------------------------------------------------------------------
    11801180 
    1181        integer nlevmax
     1181       INTEGER nlevmax
    11821182       parameter (nlevmax=41)
    1183        integer nlev_cas,mxcalc
     1183       INTEGER nlev_cas,mxcalc
    11841184!       real play(llm), plev_prof(nlevmax)
    11851185!       real t_prof(nlevmax),q_prof(nlevmax)
    … …  
    11881188!       real hq_prof(nlevmax),vq_prof(nlevmax)
    11891189 
    1190        real play(llm), plev_prof_cas(nlev_cas)
    1191        real t_prof_cas(nlev_cas),q_prof_cas(nlev_cas)
    1192        real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
    1193        real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas), vitw_prof_cas(nlev_cas)
    1194        real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
    1195        real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
    1196        real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas),dtrad_prof_cas(nlev_cas)
    1197        real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
    1198  
    1199        real t_mod_cas(llm),q_mod_cas(llm)
    1200        real u_mod_cas(llm),v_mod_cas(llm)
    1201        real ug_mod_cas(llm),vg_mod_cas(llm), w_mod_cas(llm)
    1202        real du_mod_cas(llm),hu_mod_cas(llm),vu_mod_cas(llm)
    1203        real dv_mod_cas(llm),hv_mod_cas(llm),vv_mod_cas(llm)
    1204        real dt_mod_cas(llm),ht_mod_cas(llm),vt_mod_cas(llm),dtrad_mod_cas(llm)
    1205        real dq_mod_cas(llm),hq_mod_cas(llm),vq_mod_cas(llm)
    1206  
    1207        integer l,k,k1,k2
    1208        real frac,frac1,frac2,fact
     1190       REAL play(llm), plev_prof_cas(nlev_cas)
     1191       REAL t_prof_cas(nlev_cas),q_prof_cas(nlev_cas)
     1192       REAL u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
     1193       REAL ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas), vitw_prof_cas(nlev_cas)
     1194       REAL du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
     1195       REAL dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
     1196       REAL dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas),dtrad_prof_cas(nlev_cas)
     1197       REAL dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
     1198 
     1199       REAL t_mod_cas(llm),q_mod_cas(llm)
     1200       REAL u_mod_cas(llm),v_mod_cas(llm)
     1201       REAL ug_mod_cas(llm),vg_mod_cas(llm), w_mod_cas(llm)
     1202       REAL du_mod_cas(llm),hu_mod_cas(llm),vu_mod_cas(llm)
     1203       REAL dv_mod_cas(llm),hv_mod_cas(llm),vv_mod_cas(llm)
     1204       REAL dt_mod_cas(llm),ht_mod_cas(llm),vt_mod_cas(llm),dtrad_mod_cas(llm)
     1205       REAL dq_mod_cas(llm),hq_mod_cas(llm),vq_mod_cas(llm)
     1206 
     1207       INTEGER l,k,k1,k2
     1208       REAL frac,frac1,frac2,fact
    12091209 
    12101210       do l = 1, llm
    12111211
    1212         if (play(l).ge.plev_prof_cas(nlev_cas)) THEN
     1212        IF (play(l).ge.plev_prof_cas(nlev_cas)) THEN
    12131213        mxcalc=l
    12141214         k1=0
    12151215         k2=0
    12161216
    1217          if (play(l).le.plev_prof_cas(1)) THEN
     1217         IF (play(l).le.plev_prof_cas(1)) THEN
    12181218         do k = 1, nlev_cas-1
    1219           if (play(l).le.plev_prof_cas(k).and. play(l).gt.plev_prof_cas(k+1)) THEN
     1219          IF (play(l).le.plev_prof_cas(k).AND. play(l).gt.plev_prof_cas(k+1)) THEN
    12201220            k1=k
    12211221            k2=k+1
    … …  
    12231223         enddo
    12241224
    1225          if (k1.eq.0 .or. k2.eq.0) THEN
     1225         IF (k1.EQ.0 .OR. k2.EQ.0) THEN
    12261226          WRITE(*,*) 'PB! k1, k2 = ',k1,k2
    12271227          WRITE(*,*) 'l,play(l) = ',l,play(l)/100
    … …  
    13361336!-------------------------------------------------------------------------
    13371337 
    1338        integer nlevmax
     1338       INTEGER nlevmax
    13391339       parameter (nlevmax=41)
    1340        integer nlev_dice,mxcalc,nt_dice
    1341  
    1342        real play(llm), plev_prof(nlev_dice)
    1343        real th_prof(nlev_dice),qv_prof(nlev_dice)
    1344        real u_prof(nlev_dice),v_prof(nlev_dice)
    1345        real o3_prof(nlev_dice)
    1346        real ht_prof(nlev_dice),hq_prof(nlev_dice)
    1347        real hu_prof(nlev_dice),hv_prof(nlev_dice)
    1348        real w_prof(nlev_dice),omega_prof(nlev_dice)
    1349  
    1350        real th_mod(llm),qv_mod(llm)
    1351        real u_mod(llm),v_mod(llm), o3_mod(llm)
    1352        real ht_mod(llm),hq_mod(llm)
    1353        real hu_mod(llm),hv_mod(llm),w_mod(llm),omega_mod(llm)
    1354  
    1355        integer l,k,k1,k2,kp
    1356        real aa,frac,frac1,frac2,fact
     1340       INTEGER nlev_dice,mxcalc,nt_dice
     1341 
     1342       REAL play(llm), plev_prof(nlev_dice)
     1343       REAL th_prof(nlev_dice),qv_prof(nlev_dice)
     1344       REAL u_prof(nlev_dice),v_prof(nlev_dice)
     1345       REAL o3_prof(nlev_dice)
     1346       REAL ht_prof(nlev_dice),hq_prof(nlev_dice)
     1347       REAL hu_prof(nlev_dice),hv_prof(nlev_dice)
     1348       REAL w_prof(nlev_dice),omega_prof(nlev_dice)
     1349 
     1350       REAL th_mod(llm),qv_mod(llm)
     1351       REAL u_mod(llm),v_mod(llm), o3_mod(llm)
     1352       REAL ht_mod(llm),hq_mod(llm)
     1353       REAL hu_mod(llm),hv_mod(llm),w_mod(llm),omega_mod(llm)
     1354 
     1355       INTEGER l,k,k1,k2,kp
     1356       REAL aa,frac,frac1,frac2,fact
    13571357 
    13581358       do l = 1, llm
    13591359
    1360         if (play(l).ge.plev_prof(nlev_dice)) THEN
     1360        IF (play(l).ge.plev_prof(nlev_dice)) THEN
    13611361        mxcalc=l
    13621362         k1=0
    13631363         k2=0
    13641364
    1365          if (play(l).le.plev_prof(1)) THEN
     1365         IF (play(l).le.plev_prof(1)) THEN
    13661366         do k = 1, nlev_dice-1
    1367           if (play(l).le.plev_prof(k) .and. play(l).gt.plev_prof(k+1)) THEN
     1367          IF (play(l).le.plev_prof(k) .AND. play(l).gt.plev_prof(k+1)) THEN
    13681368            k1=k
    13691369            k2=k+1
    … …  
    13711371         enddo
    13721372
    1373          if (k1.eq.0 .or. k2.eq.0) THEN
     1373         IF (k1.EQ.0 .OR. k2.EQ.0) THEN
    13741374          WRITE(*,*) 'PB! k1, k2 = ',k1,k2
    13751375          WRITE(*,*) 'l,play(l) = ',l,play(l)/100
    … …  
    14601460
    14611461! inputs:
    1462         integer annee_ref
    1463         integer nt_astex,nlev_astex
    1464         integer year_ini_astex
    1465         real day, day1,day_ini_astex,dt_astex
    1466         real div_astex(nt_astex),ts_astex(nt_astex),ug_astex(nt_astex)
    1467         real vg_astex(nt_astex),ufa_astex(nt_astex),vfa_astex(nt_astex)
     1462        INTEGER annee_ref
     1463        INTEGER nt_astex,nlev_astex
     1464        INTEGER year_ini_astex
     1465        REAL day, day1,day_ini_astex,dt_astex
     1466        REAL div_astex(nt_astex),ts_astex(nt_astex),ug_astex(nt_astex)
     1467        REAL vg_astex(nt_astex),ufa_astex(nt_astex),vfa_astex(nt_astex)
    14681468! outputs:
    1469         real div_prof,ts_prof,ug_prof,vg_prof,ufa_prof,vfa_prof
     1469        REAL div_prof,ts_prof,ug_prof,vg_prof,ufa_prof,vfa_prof
    14701470! local:
    1471         integer it_astex1, it_astex2
    1472         real timeit,time_astex1,time_astex2,frac
     1471        INTEGER it_astex1, it_astex2
     1472        REAL timeit,time_astex1,time_astex2,frac
    14731473
    14741474! Check that initial day of the simulation consistent with ASTEX period:
    1475        if (annee_ref.ne.1992 ) THEN
     1475       IF (annee_ref.NE.1992 ) THEN
    14761476        PRINT*,'Pour Astex, annee_ref doit etre 1992 '
    14771477        PRINT*,'Changer annee_ref dans run.def'
    14781478        stop
    14791479       endif
    1480        if (annee_ref.eq.1992 .and. day1.lt.day_ini_astex) THEN
     1480       IF (annee_ref.EQ.1992 .AND. day1.lt.day_ini_astex) THEN
    14811481        PRINT*,'Astex debute le 13 Juin 1992 (jour julien=165)'
    14821482        PRINT*,'Changer dayref dans run.def'
    … …  
    14861486! Determine timestep relative to the 1st day of TOGA-COARE:
    14871487!       timeit=(day-day1)*86400.
    1488 !       if (annee_ref.eq.1992) THEN
     1488!       if (annee_ref.EQ.1992) THEN
    14891489!        timeit=(day-day_ini_astex)*86400.
    14901490!       else
    … …  
    15021502     &          it_astex1,it_astex2,time_astex1,time_astex2
    15031503
    1504        if (it_astex1 .ge. nt_astex) THEN
     1504       IF (it_astex1 .ge. nt_astex) THEN
    15051505        WRITE(*,*) 'PB-stop: day, it_astex1, it_astex2, timeit: '          &
    15061506     &        ,day,it_astex1,it_astex2,timeit/86400.
    … …  
    15541554
    15551555! inputs:
    1556         integer annee_ref
    1557         integer nt_toga,nlev_toga
    1558         integer year_ini_toga
    1559         real day, day1,day_ini_toga,dt_toga
    1560         real ts_toga(nt_toga)
    1561         real plev_toga(nlev_toga,nt_toga),t_toga(nlev_toga,nt_toga)
    1562         real q_toga(nlev_toga,nt_toga),u_toga(nlev_toga,nt_toga)
    1563         real v_toga(nlev_toga,nt_toga),w_toga(nlev_toga,nt_toga)
    1564         real ht_toga(nlev_toga,nt_toga),vt_toga(nlev_toga,nt_toga)
    1565         real hq_toga(nlev_toga,nt_toga),vq_toga(nlev_toga,nt_toga)
     1556        INTEGER annee_ref
     1557        INTEGER nt_toga,nlev_toga
     1558        INTEGER year_ini_toga
     1559        REAL day, day1,day_ini_toga,dt_toga
     1560        REAL ts_toga(nt_toga)
     1561        REAL plev_toga(nlev_toga,nt_toga),t_toga(nlev_toga,nt_toga)
     1562        REAL q_toga(nlev_toga,nt_toga),u_toga(nlev_toga,nt_toga)
     1563        REAL v_toga(nlev_toga,nt_toga),w_toga(nlev_toga,nt_toga)
     1564        REAL ht_toga(nlev_toga,nt_toga),vt_toga(nlev_toga,nt_toga)
     1565        REAL hq_toga(nlev_toga,nt_toga),vq_toga(nlev_toga,nt_toga)
    15661566! outputs:
    1567         real ts_prof
    1568         real plev_prof(nlev_toga),t_prof(nlev_toga)
    1569         real q_prof(nlev_toga),u_prof(nlev_toga)
    1570         real v_prof(nlev_toga),w_prof(nlev_toga)
    1571         real ht_prof(nlev_toga),vt_prof(nlev_toga)
    1572         real hq_prof(nlev_toga),vq_prof(nlev_toga)
     1567        REAL ts_prof
     1568        REAL plev_prof(nlev_toga),t_prof(nlev_toga)
     1569        REAL q_prof(nlev_toga),u_prof(nlev_toga)
     1570        REAL v_prof(nlev_toga),w_prof(nlev_toga)
     1571        REAL ht_prof(nlev_toga),vt_prof(nlev_toga)
     1572        REAL hq_prof(nlev_toga),vq_prof(nlev_toga)
    15731573! local:
    1574         integer it_toga1, it_toga2,k
    1575         real timeit,time_toga1,time_toga2,frac
    1576 
    1577 
    1578         if (forcing_type.eq.2) THEN
     1574        INTEGER it_toga1, it_toga2,k
     1575        REAL timeit,time_toga1,time_toga2,frac
     1576
     1577
     1578        IF (forcing_type.EQ.2) THEN
    15791579! Check that initial day of the simulation consistent with TOGA-COARE period:
    1580        if (annee_ref.ne.1992 .and. annee_ref.ne.1993) THEN
     1580       IF (annee_ref.NE.1992 .AND. annee_ref.NE.1993) THEN
    15811581        PRINT*,'Pour TOGA-COARE, annee_ref doit etre 1992 ou 1993'
    15821582        PRINT*,'Changer annee_ref dans run.def'
    15831583        stop
    15841584       endif
    1585        if (annee_ref.eq.1992 .and. day1.lt.day_ini_toga) THEN
     1585       IF (annee_ref.EQ.1992 .AND. day1.lt.day_ini_toga) THEN
    15861586        PRINT*,'TOGA-COARE a debute le 1er Nov 1992 (jour julien=306)'
    15871587        PRINT*,'Changer dayref dans run.def'
    15881588        stop
    15891589       endif
    1590        if (annee_ref.eq.1993 .and. day1.gt.day_ini_toga+119) THEN
     1590       IF (annee_ref.EQ.1993 .AND. day1.gt.day_ini_toga+119) THEN
    15911591        PRINT*,'TOGA-COARE a fini le 28 Feb 1993 (jour julien=59)'
    15921592        PRINT*,'Changer dayref ou nday dans run.def'
    … …  
    15941594       endif
    15951595
    1596        else if (forcing_type.eq.4) THEN
     1596       ELSE IF (forcing_type.EQ.4) THEN
    15971597! Check that initial day of the simulation consistent with TWP-ICE period:
    1598        if (annee_ref.ne.2006) THEN
     1598       IF (annee_ref.NE.2006) THEN
    15991599        PRINT*,'Pour TWP-ICE, annee_ref doit etre 2006'
    16001600        PRINT*,'Changer annee_ref dans run.def'
    16011601        stop
    16021602       endif
    1603        if (annee_ref.eq.2006 .and. day1.lt.day_ini_toga) THEN
     1603       IF (annee_ref.EQ.2006 .AND. day1.lt.day_ini_toga) THEN
    16041604        PRINT*,'TWP-ICE a debute le 17 Jan 2006 (jour julien=17)'
    16051605        PRINT*,'Changer dayref dans run.def'
    16061606        stop
    16071607       endif
    1608        if (annee_ref.eq.2006 .and. day1.gt.day_ini_toga+26) THEN
     1608       IF (annee_ref.EQ.2006 .AND. day1.gt.day_ini_toga+26) THEN
    16091609        PRINT*,'TWP-ICE a fini le 12 Feb 2006 (jour julien=43)'
    16101610        PRINT*,'Changer dayref ou nday dans run.def'
    … …  
    16161616! Determine timestep relative to the 1st day of TOGA-COARE:
    16171617!       timeit=(day-day1)*86400.
    1618 !       if (annee_ref.eq.1992) THEN
     1618!       if (annee_ref.EQ.1992) THEN
    16191619!        timeit=(day-day_ini_toga)*86400.
    16201620!       else
    … …  
    16291629       time_toga2=(it_toga2-1)*dt_toga
    16301630
    1631        if (it_toga1 .ge. nt_toga) THEN
     1631       IF (it_toga1 .ge. nt_toga) THEN
    16321632        WRITE(*,*) 'PB-stop: day, it_toga1, it_toga2, timeit: '            &
    16331633     &        ,day,it_toga1,it_toga2,timeit/86400.
    … …  
    16951695
    16961696! inputs:
    1697         integer annee_ref
    1698         integer nt_dice,nlev_dice
    1699         integer year_ini_dice
    1700         real day, day1,day_ini_dice,dt_dice
    1701         real shf_dice(nt_dice),lhf_dice(nt_dice),lwup_dice(nt_dice)
    1702         real swup_dice(nt_dice),tg_dice(nt_dice),ustar_dice(nt_dice)
    1703         real psurf_dice(nt_dice),ug_dice(nt_dice),vg_dice(nt_dice)
    1704         real ht_dice(nlev_dice,nt_dice),hq_dice(nlev_dice,nt_dice)
    1705         real hu_dice(nlev_dice,nt_dice),hv_dice(nlev_dice,nt_dice)
    1706         real w_dice(nlev_dice,nt_dice),omega_dice(nlev_dice,nt_dice)
     1697        INTEGER annee_ref
     1698        INTEGER nt_dice,nlev_dice
     1699        INTEGER year_ini_dice
     1700        REAL day, day1,day_ini_dice,dt_dice
     1701        REAL shf_dice(nt_dice),lhf_dice(nt_dice),lwup_dice(nt_dice)
     1702        REAL swup_dice(nt_dice),tg_dice(nt_dice),ustar_dice(nt_dice)
     1703        REAL psurf_dice(nt_dice),ug_dice(nt_dice),vg_dice(nt_dice)
     1704        REAL ht_dice(nlev_dice,nt_dice),hq_dice(nlev_dice,nt_dice)
     1705        REAL hu_dice(nlev_dice,nt_dice),hv_dice(nlev_dice,nt_dice)
     1706        REAL w_dice(nlev_dice,nt_dice),omega_dice(nlev_dice,nt_dice)
    17071707! outputs:
    1708         real tg_prof,shf_prof,lhf_prof,lwup_prof,swup_prof
    1709         real ustar_prof,psurf_prof,ug_prof,vg_prof
    1710         real ht_prof(nlev_dice),hq_prof(nlev_dice)
    1711         real hu_prof(nlev_dice),hv_prof(nlev_dice)
    1712         real w_prof(nlev_dice),omega_prof(nlev_dice)
     1708        REAL tg_prof,shf_prof,lhf_prof,lwup_prof,swup_prof
     1709        REAL ustar_prof,psurf_prof,ug_prof,vg_prof
     1710        REAL ht_prof(nlev_dice),hq_prof(nlev_dice)
     1711        REAL hu_prof(nlev_dice),hv_prof(nlev_dice)
     1712        REAL w_prof(nlev_dice),omega_prof(nlev_dice)
    17131713! local:
    1714         integer it_dice1, it_dice2,k
    1715         real timeit,time_dice1,time_dice2,frac
    1716 
    1717 
    1718         if (forcing_type.eq.7) THEN
     1714        INTEGER it_dice1, it_dice2,k
     1715        REAL timeit,time_dice1,time_dice2,frac
     1716
     1717
     1718        IF (forcing_type.EQ.7) THEN
    17191719! Check that initial day of the simulation consistent with Dice period:
    17201720       print *,'annee_ref=',annee_ref
    17211721       print *,'day1=',day1
    17221722       print *,'day_ini_dice=',day_ini_dice
    1723        if (annee_ref.ne.1999) THEN
     1723       IF (annee_ref.NE.1999) THEN
    17241724        PRINT*,'Pour Dice, annee_ref doit etre 1999'
    17251725        PRINT*,'Changer annee_ref dans run.def'
    17261726        stop
    17271727       endif
    1728        if (annee_ref.eq.1999 .and. day1.gt.day_ini_dice) THEN
     1728       IF (annee_ref.EQ.1999 .AND. day1.gt.day_ini_dice) THEN
    17291729        PRINT*,'Dice a debute le 23 Oct 1999 (jour julien=296)'
    17301730        PRINT*,'Changer dayref dans run.def',day1,day_ini_dice
    17311731        stop
    17321732       endif
    1733        if (annee_ref.eq.1999 .and. day1.gt.day_ini_dice+2) THEN
     1733       IF (annee_ref.EQ.1999 .AND. day1.gt.day_ini_dice+2) THEN
    17341734        PRINT*,'Dice a fini le 25 Oct 1999 (jour julien=298)'
    17351735        PRINT*,'Changer dayref ou nday dans run.def',day1,day_ini_dice
    … …  
    17411741! Determine timestep relative to the 1st day of TOGA-COARE:
    17421742!       timeit=(day-day1)*86400.
    1743 !       if (annee_ref.eq.1992) THEN
     1743!       if (annee_ref.EQ.1992) THEN
    17441744!        timeit=(day-day_ini_dice)*86400.
    17451745!       else
    … …  
    17541754       time_dice2=(it_dice2-1)*dt_dice
    17551755
    1756        if (it_dice1 .ge. nt_dice) THEN
     1756       IF (it_dice1 .ge. nt_dice) THEN
    17571757        WRITE(*,*) 'PB-stop: day, it_dice1, it_dice2, timeit: ',day,it_dice1,it_dice2,timeit/86400.
    17581758        stop
    … …  
    18081808
    18091809! inputs:
    1810         integer annee_ref
    1811         integer nt_gabls4,nlev_gabls4
    1812         integer year_ini_gabls4
    1813         real day, day1,day_ini_gabls4,dt_gabls4
    1814         real ug_gabls4(nlev_gabls4,nt_gabls4),vg_gabls4(nlev_gabls4,nt_gabls4)
    1815         real ht_gabls4(nlev_gabls4,nt_gabls4),hq_gabls4(nlev_gabls4,nt_gabls4)
    1816         real tg_gabls4(nt_gabls4), tg_prof
     1810        INTEGER annee_ref
     1811        INTEGER nt_gabls4,nlev_gabls4
     1812        INTEGER year_ini_gabls4
     1813        REAL day, day1,day_ini_gabls4,dt_gabls4
     1814        REAL ug_gabls4(nlev_gabls4,nt_gabls4),vg_gabls4(nlev_gabls4,nt_gabls4)
     1815        REAL ht_gabls4(nlev_gabls4,nt_gabls4),hq_gabls4(nlev_gabls4,nt_gabls4)
     1816        REAL tg_gabls4(nt_gabls4), tg_prof
    18171817! outputs:
    1818         real ug_prof(nlev_gabls4),vg_prof(nlev_gabls4)
    1819         real ht_prof(nlev_gabls4),hq_prof(nlev_gabls4)
     1818        REAL ug_prof(nlev_gabls4),vg_prof(nlev_gabls4)
     1819        REAL ht_prof(nlev_gabls4),hq_prof(nlev_gabls4)
    18201820! local:
    1821         integer it_gabls41, it_gabls42,k
    1822         real timeit,time_gabls41,time_gabls42,frac
     1821        INTEGER it_gabls41, it_gabls42,k
     1822        REAL timeit,time_gabls41,time_gabls42,frac
    18231823
    18241824
    18251825
    18261826! Check that initial day of the simulation consistent with gabls4 period:
    1827        if (forcing_type.eq.8 ) THEN
     1827       IF (forcing_type.EQ.8 ) THEN
    18281828       print *,'annee_ref=',annee_ref
    18291829       print *,'day1=',day1
    18301830       print *,'day_ini_gabls4=',day_ini_gabls4
    1831        if (annee_ref.ne.2009) THEN
     1831       IF (annee_ref.NE.2009) THEN
    18321832        PRINT*,'Pour gabls4, annee_ref doit etre 2009'
    18331833        PRINT*,'Changer annee_ref dans run.def'
    18341834        stop
    18351835       endif
    1836        if (annee_ref.eq.2009 .and. day1.gt.day_ini_gabls4) THEN
     1836       IF (annee_ref.EQ.2009 .AND. day1.gt.day_ini_gabls4) THEN
    18371837        PRINT*,'gabls4 a debute le 11 dec 2009 (jour julien=345)'
    18381838        PRINT*,'Changer dayref dans run.def',day1,day_ini_gabls4
    18391839        stop
    18401840       endif
    1841        if (annee_ref.eq.2009 .and. day1.gt.day_ini_gabls4+2) THEN
     1841       IF (annee_ref.EQ.2009 .AND. day1.gt.day_ini_gabls4+2) THEN
    18421842        PRINT*,'gabls4 a fini le 12 dec 2009 (jour julien=346)'
    18431843        PRINT*,'Changer dayref ou nday dans run.def',day1,day_ini_gabls4
    … …  
    18561856       time_gabls42=(it_gabls42-1)*dt_gabls4
    18571857
    1858        if (it_gabls41 .ge. nt_gabls4) THEN
     1858       IF (it_gabls41 .ge. nt_gabls4) THEN
    18591859        WRITE(*,*) 'PB-stop: day, it_gabls41, it_gabls42, timeit: ',day,it_gabls41,it_gabls42,timeit/86400.
    18601860        stop
    … …  
    18961896
    18971897! inputs:
    1898         integer annee_ref
    1899         integer nt_armcu,nlev_armcu
    1900         integer year_ini_armcu
    1901         real day, day1,day_ini_armcu,dt_armcu
    1902         real fs_armcu(nt_armcu),fl_armcu(nt_armcu),at_armcu(nt_armcu)
    1903         real rt_armcu(nt_armcu),aqt_armcu(nt_armcu)
     1898        INTEGER annee_ref
     1899        INTEGER nt_armcu,nlev_armcu
     1900        INTEGER year_ini_armcu
     1901        REAL day, day1,day_ini_armcu,dt_armcu
     1902        REAL fs_armcu(nt_armcu),fl_armcu(nt_armcu),at_armcu(nt_armcu)
     1903        REAL rt_armcu(nt_armcu),aqt_armcu(nt_armcu)
    19041904! outputs:
    1905         real fs_prof,fl_prof,at_prof,rt_prof,aqt_prof
     1905        REAL fs_prof,fl_prof,at_prof,rt_prof,aqt_prof
    19061906! local:
    1907         integer it_armcu1, it_armcu2,k
    1908         real timeit,time_armcu1,time_armcu2,frac
     1907        INTEGER it_armcu1, it_armcu2,k
     1908        REAL timeit,time_armcu1,time_armcu2,frac
    19091909
    19101910! Check that initial day of the simulation consistent with ARMCU period:
    1911        if (annee_ref.ne.1997 ) THEN
     1911       IF (annee_ref.NE.1997 ) THEN
    19121912        PRINT*,'Pour ARMCU, annee_ref doit etre 1997 '
    19131913        PRINT*,'Changer annee_ref dans run.def'
    … …  
    19261926     &          it_armcu1,it_armcu2,time_armcu1,time_armcu2
    19271927
    1928        if (it_armcu1 .ge. nt_armcu) THEN
     1928       IF (it_armcu1 .ge. nt_armcu) THEN
    19291929        WRITE(*,*) 'PB-stop: day, it_armcu1, it_armcu2, timeit: '          &
    19301930     &        ,day,it_armcu1,it_armcu2,timeit/86400.
    … …  
    19631963      IMPLICIT NONE
    19641964
    1965         integer nlev_max,kmax,kmax2,ntrac
    1966         logical :: llesread = .TRUE.
    1967 
    1968         real height(nlev_max),thlprof(nlev_max),qtprof(nlev_max),          &
     1965        INTEGER nlev_max,kmax,kmax2,ntrac
     1966        LOGICAL :: llesread = .TRUE.
     1967
     1968        REAL height(nlev_max),thlprof(nlev_max),qtprof(nlev_max),          &
    19691969     &       uprof(nlev_max),vprof(nlev_max),e12prof(nlev_max),            &
    19701970     &       ugprof(nlev_max),vgprof(nlev_max),wfls(nlev_max),             &
    … …  
    19721972     &           thlpcar(nlev_max),tracer(nlev_max,ntrac)
    19731973
    1974         real height1(nlev_max)
    1975 
    1976         integer, parameter :: ilesfile=1
     1974        REAL height1(nlev_max)
     1975
     1976        INTEGER, parameter :: ilesfile=1
    19771977        INTEGER :: ierr,k,itrac,nt1,nt2
    19781978
    1979         IF(.not.(llesread)) return
     1979        IF(.NOT.(llesread)) return
    19801980
    19811981       open (ilesfile,file='prof.inp.001',status='old',iostat=ierr)
    1982         if (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
     1982        IF (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
    19831983        read (ilesfile,*) kmax
    19841984        do k=1,kmax
    … …  
    19891989
    19901990       open(ilesfile,file='lscale.inp.001',status='old',iostat=ierr)
    1991         if (ierr /= 0) stop 'ERROR:Lscale.inp does not exist'
     1991        IF (ierr /= 0) stop 'ERROR:Lscale.inp does not exist'
    19921992        read (ilesfile,*) kmax2
    1993         if (kmax .ne. kmax2) THEN
     1993        IF (kmax .NE. kmax2) THEN
    19941994          print *, 'fichiers prof.inp et lscale.inp incompatibles :'
    19951995          print *, 'nbre de niveaux : ',kmax,' et ',kmax2
    … …  
    20012001        END DO
    20022002        do k=1,kmax
    2003           if (height(k) .ne. height1(k)) THEN
     2003          IF (height(k) .NE. height1(k)) THEN
    20042004            print *, 'fichiers prof.inp et lscale.inp incompatibles :'
    20052005            print *, 'les niveaux different : ',k,height1(k), height(k)
    … …  
    20102010
    20112011       open(ilesfile,file='trac.inp.001',status='old',iostat=ierr)
    2012         if (ierr /= 0) THEN
     2012        IF (ierr /= 0) THEN
    20132013            PRINT*,'WARNING : trac.inp does not exist'
    20142014        else
    20152015        read (ilesfile,*) kmax2,nt1,nt2
    2016         if (nt2>ntrac) THEN
     2016        IF (nt2>ntrac) THEN
    20172017          stop 'Augmenter le nombre de traceurs dans traceur.def'
    20182018        endif
    2019         if (kmax .ne. kmax2) THEN
     2019        IF (kmax .NE. kmax2) THEN
    20202020          print *, 'fichiers prof.inp et lscale.inp incompatibles :'
    20212021          print *, 'nbre de niveaux : ',kmax,' et ',kmax2
    … …  
    20362036      IMPLICIT NONE
    20372037
    2038         integer nlev_max,kmax
    2039         logical :: llesread = .TRUE.
    2040 
    2041         real height(nlev_max),pprof(nlev_max),tprof(nlev_max)
    2042         real thlprof(nlev_max)
    2043         real qprof(nlev_max),uprof(nlev_max),vprof(nlev_max)
    2044         real wprof(nlev_max),omega(nlev_max),o3mmr(nlev_max)
    2045 
    2046         integer, parameter :: ilesfile=1
     2038        INTEGER nlev_max,kmax
     2039        LOGICAL :: llesread = .TRUE.
     2040
     2041        REAL height(nlev_max),pprof(nlev_max),tprof(nlev_max)
     2042        REAL thlprof(nlev_max)
     2043        REAL qprof(nlev_max),uprof(nlev_max),vprof(nlev_max)
     2044        REAL wprof(nlev_max),omega(nlev_max),o3mmr(nlev_max)
     2045
     2046        INTEGER, parameter :: ilesfile=1
    20472047        INTEGER :: k,ierr
    20482048
    2049         IF(.not.(llesread)) return
     2049        IF(.NOT.(llesread)) return
    20502050
    20512051       open (ilesfile,file='prof.inp.001',status='old',iostat=ierr)
    2052         if (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
     2052        IF (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
    20532053        read (ilesfile,*) kmax
    20542054        do k=1,kmax
    … …  
    20682068      IMPLICIT NONE
    20692069
    2070         integer nlev_max,kmax
    2071         logical :: llesread = .TRUE.
    2072 
    2073         real height(nlev_max),pprof(nlev_max),tprof(nlev_max),             &
     2070        INTEGER nlev_max,kmax
     2071        LOGICAL :: llesread = .TRUE.
     2072
     2073        REAL height(nlev_max),pprof(nlev_max),tprof(nlev_max),             &
    20742074     &  thlprof(nlev_max),qlprof(nlev_max),qtprof(nlev_max),               &
    20752075     &  qvprof(nlev_max),uprof(nlev_max),vprof(nlev_max),                  &
    20762076     &  wprof(nlev_max),tkeprof(nlev_max),o3mmr(nlev_max)
    20772077
    2078         integer, parameter :: ilesfile=1
     2078        INTEGER, parameter :: ilesfile=1
    20792079        INTEGER :: ierr,k
    20802080
    2081         IF(.not.(llesread)) return
     2081        IF(.NOT.(llesread)) return
    20822082
    20832083       open (ilesfile,file='prof.inp.001',status='old',iostat=ierr)
    2084         if (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
     2084        IF (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
    20852085        read (ilesfile,*) kmax
    20862086        do k=1,kmax
    … …  
    21022102      IMPLICIT NONE
    21032103
    2104         integer nlev_max,kmax
    2105         logical :: llesread = .TRUE.
    2106 
    2107         real height(nlev_max),pprof(nlev_max),tprof(nlev_max)
    2108         real thetaprof(nlev_max),rvprof(nlev_max)
    2109         real qvprof(nlev_max),uprof(nlev_max),vprof(nlev_max)
    2110         real aprof(nlev_max+1),bprof(nlev_max+1)
    2111 
    2112         integer, parameter :: ilesfile=1
    2113         integer, parameter :: ifile=2
     2104        INTEGER nlev_max,kmax
     2105        LOGICAL :: llesread = .TRUE.
     2106
     2107        REAL height(nlev_max),pprof(nlev_max),tprof(nlev_max)
     2108        REAL thetaprof(nlev_max),rvprof(nlev_max)
     2109        REAL qvprof(nlev_max),uprof(nlev_max),vprof(nlev_max)
     2110        REAL aprof(nlev_max+1),bprof(nlev_max+1)
     2111
     2112        INTEGER, parameter :: ilesfile=1
     2113        INTEGER, parameter :: ifile=2
    21142114        INTEGER :: ierr,jtot,k
    21152115
    2116         IF(.not.(llesread)) return
     2116        IF(.NOT.(llesread)) return
    21172117
    21182118! Read profiles at full levels
    … …  
    21242124       print *,'On ouvre prof.inp.40'
    21252125       ENDIF
    2126         if (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
     2126        IF (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
    21272127        read (ilesfile,*) kmax
    21282128        do k=1,kmax
    … …  
    21362136       open (ifile,file='proh.inp.19',status='old',iostat=ierr)
    21372137       print *,'On ouvre proh.inp.19'
    2138        if (ierr /= 0) stop 'ERROR:Proh.inp.19 does not exist'
     2138       IF (ierr /= 0) stop 'ERROR:Proh.inp.19 does not exist'
    21392139       ELSE
    21402140       open (ifile,file='proh.inp.40',status='old',iostat=ierr)
    21412141       print *,'On ouvre proh.inp.40'
    2142        if (ierr /= 0) stop 'ERROR:Proh.inp.40 does not exist'
     2142       IF (ierr /= 0) stop 'ERROR:Proh.inp.40 does not exist'
    21432143       ENDIF
    21442144        read (ifile,*) kmax
    … …  
    21592159
    21602160
    2161       use netcdf, ONLY: nf90_open,nf90_nowrite,nf90_noerr,nf90_strerror,nf90_inq_varid,nf90_get_var,&
     2161      USE netcdf, ONLY: nf90_open,nf90_nowrite,nf90_noerr,nf90_strerror,nf90_inq_varid,nf90_get_var,&
    21622162            nf90_inq_dimid,nf90_inquire_dimension
    21632163      IMPLICIT NONE
    21642164
    2165       integer ntime,nlevel
     2165      INTEGER ntime,nlevel
    21662166      character*80 :: fich_fire
    21672167      real*8 zz(nlevel)
    … …  
    21742174      real*8 dqtdt(nlevel,ntime),thl_rad(nlevel,ntime)
    21752175
    2176       integer nid, ierr
    2177       integer nbvar3d
     2176      INTEGER nid, ierr
     2177      INTEGER nbvar3d
    21782178      parameter(nbvar3d=30)
    2179       integer var3didin(nbvar3d)
     2179      INTEGER var3didin(nbvar3d)
    21802180
    21812181      ierr = nf90_open(fich_fire,nf90_nowrite,nid)
    2182       if (ierr.NE.nf90_noerr) THEN
     2182      IF (ierr.NE.nf90_noerr) THEN
    21832183         WRITE(*,*) 'ERROR: Pb opening forcings nc file '
    21842184         WRITE(*,*) nf90_strerror(ierr)
    … …  
    23692369!program reading initial profils and forcings of the Dice case study
    23702370
    2371       use netcdf, ONLY: nf90_open,nf90_nowrite,nf90_noerr,nf90_strerror,nf90_inq_varid,nf90_get_var,&
     2371      USE netcdf, ONLY: nf90_open,nf90_nowrite,nf90_noerr,nf90_strerror,nf90_inq_varid,nf90_get_var,&
    23722372            nf90_inq_dimid,nf90_inquire_dimension
    23732373
    … …  
    23762376      INCLUDE "YOMCST.h"
    23772377
    2378       integer ntime,nlevel
    2379       integer l,k
     2378      INTEGER ntime,nlevel
     2379      INTEGER l,k
    23802380      character*80 :: fich_dice
    23812381      real*8 time(ntime)
    … …  
    23902390      real*8 pzero
    23912391
    2392       integer nid, ierr
    2393       integer nbvar3d
     2392      INTEGER nid, ierr
     2393      INTEGER nbvar3d
    23942394      parameter(nbvar3d=30)
    2395       integer var3didin(nbvar3d)
     2395      INTEGER var3didin(nbvar3d)
    23962396
    23972397      pzero=100000.
    23982398      ierr = nf90_open(fich_dice,nf90_nowrite,nid)
    2399       if (ierr.NE.nf90_noerr) THEN
     2399      IF (ierr.NE.nf90_noerr) THEN
    24002400         WRITE(*,*) 'ERROR: Pb opening forcings nc file '
    24012401         WRITE(*,*) nf90_strerror(ierr)
    … …  
    27032703!program reading initial profils and forcings of the Gabls4 case study
    27042704
    2705       use netcdf, ONLY: nf90_open,nf90_nowrite,nf90_noerr,nf90_strerror,nf90_inq_varid,nf90_get_var,&
     2705      USE netcdf, ONLY: nf90_open,nf90_nowrite,nf90_noerr,nf90_strerror,nf90_inq_varid,nf90_get_var,&
    27062706            nf90_inq_dimid,nf90_inquire_dimension
    27072707
    27082708      IMPLICIT NONE
    27092709
    2710       integer ntime,nlevel,nsol
    2711       integer l,k
     2710      INTEGER ntime,nlevel,nsol
     2711      INTEGER l,k
    27122712      character*80 :: fich_gabls4
    27132713      real*8 time(ntime)
    … …  
    27272727      real*8 depth_sn(nsol),tsnow(nsol),snow_dens(nsol)
    27282728      real*8 tg(ntime)
    2729       integer nid, ierr
    2730       integer nbvar3d
     2729      INTEGER nid, ierr
     2730      INTEGER nbvar3d
    27312731      parameter(nbvar3d=30)
    2732       integer var3didin(nbvar3d)
     2732      INTEGER var3didin(nbvar3d)
    27332733
    27342734      ierr = nf90_open(fich_gabls4,nf90_nowrite,nid)
    2735       if (ierr.NE.nf90_noerr) THEN
     2735      IF (ierr.NE.nf90_noerr) THEN
    27362736         WRITE(*,*) 'ERROR: Pb opening forcings nc file '
    27372737         WRITE(*,*) nf90_strerror(ierr)
    … …  
    29492949      INCLUDE "YOMCST.h"
    29502950
    2951       real albsfc(ncm_1), albsfc_w(ncm_1)
    2952       real cf(nlev_circ), icefra(nlev_circ), deice(nlev_circ), &
     2951      REAL albsfc(ncm_1), albsfc_w(ncm_1)
     2952      REAL cf(nlev_circ), icefra(nlev_circ), deice(nlev_circ), &
    29532953           reliq(nlev_circ), reice(nlev_circ), lwp(nlev_circ), iwp(nlev_circ)
    2954       real t(nlev_circ+1), z(nlev_circ+1), dz(nlev_circ), p(nlev_circ+1)
    2955       real aer_beta(nlev_circ), waer(nlev_circ), gaer(nlev_circ)
    2956       real pm(nlev_circ), tm(nlev_circ), h2o(nlev_circ), o3(nlev_circ)
    2957       real co2(nlev_circ), n2o(nlev_circ), co(nlev_circ), ch4(nlev_circ), &
     2954      REAL t(nlev_circ+1), z(nlev_circ+1), dz(nlev_circ), p(nlev_circ+1)
     2955      REAL aer_beta(nlev_circ), waer(nlev_circ), gaer(nlev_circ)
     2956      REAL pm(nlev_circ), tm(nlev_circ), h2o(nlev_circ), o3(nlev_circ)
     2957      REAL co2(nlev_circ), n2o(nlev_circ), co(nlev_circ), ch4(nlev_circ), &
    29582958           o2(nlev_circ), ccl4(nlev_circ), f11(nlev_circ), f12(nlev_circ)
    29592959!     za= zenital angle
    29602960!     sza= cosinus angle zenital
    2961       real wavn(ncm_1), ssf(ncm_1),za,sza
    2962       integer nlev
     2961      REAL wavn(ncm_1), ssf(ncm_1),za,sza
     2962      INTEGER nlev
    29632963
    29642964
    … …  
    30533053      INCLUDE "YOMCST.h"
    30543054
    3055       real t(nlev_rtmip), pt(nlev_rtmip),pb(nlev_rtmip),h2o(nlev_rtmip), o3(nlev_rtmip)
    3056       real temp(nlev_rtmip), play(nlev_rtmip),ovap(nlev_rtmip), oz(nlev_rtmip),plev(nlev_rtmip+1)
    3057       integer nlev
     3055      REAL t(nlev_rtmip), pt(nlev_rtmip),pb(nlev_rtmip),h2o(nlev_rtmip), o3(nlev_rtmip)
     3056      REAL temp(nlev_rtmip), play(nlev_rtmip),ovap(nlev_rtmip), oz(nlev_rtmip),plev(nlev_rtmip+1)
     3057      INTEGER nlev
    30583058
    30593059

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_1D_decl_cases.h

    r5103 r5117  
    44!        integer nlev_prof
    55!        parameter (nlev_prof = 41)
    6         integer nlev_toga, nt_toga
     6        INTEGER nlev_toga, nt_toga
    77        parameter (nlev_toga=41, nt_toga=480)
    8         integer year_ini_toga, day_ini_toga, mth_ini_toga
    9         real day_ju_ini_toga   ! Julian day of toga coare first day
     8        INTEGER year_ini_toga, day_ini_toga, mth_ini_toga
     9        REAL day_ju_ini_toga   ! Julian day of toga coare first day
    1010        parameter (year_ini_toga=1992)
    1111        parameter (mth_ini_toga=11)
    1212        parameter (day_ini_toga=1)  !  1erNov1992
    13         real dt_toga
     13        REAL dt_toga
    1414        parameter (dt_toga=6.*3600.)
    1515!!
    16         integer year_print, month_print, day_print
     16        INTEGER year_print, month_print, day_print
    1717        real    sec_print
    1818!!
    19         real ts_toga(nt_toga)
    20         real plev_toga(nlev_toga,nt_toga),w_toga(nlev_toga,nt_toga)
    21         real t_toga(nlev_toga,nt_toga),q_toga(nlev_toga,nt_toga)
    22         real u_toga(nlev_toga,nt_toga),v_toga(nlev_toga,nt_toga)
    23         real ht_toga(nlev_toga,nt_toga),vt_toga(nlev_toga,nt_toga)
    24         real hq_toga(nlev_toga,nt_toga),vq_toga(nlev_toga,nt_toga)
    25 
    26         real ts_prof
    27         real plev_prof(nlev_toga),w_prof(nlev_toga)
    28         real t_prof(nlev_toga),q_prof(nlev_toga)
    29         real u_prof(nlev_toga),v_prof(nlev_toga)
    30         real ht_prof(nlev_toga),vt_prof(nlev_toga)
    31         real hq_prof(nlev_toga),vq_prof(nlev_toga)
    32 
    33         real w_mod(llm), t_mod(llm),q_mod(llm)
    34         real u_mod(llm),v_mod(llm), ht_mod(llm),vt_mod(llm),ug_mod(llm),vg_mod(llm)
    35         real hq_mod(llm),vq_mod(llm),qv_mod(llm),ql_mod(llm),qt_mod(llm)
    36         real th_mod(llm)
     19        REAL ts_toga(nt_toga)
     20        REAL plev_toga(nlev_toga,nt_toga),w_toga(nlev_toga,nt_toga)
     21        REAL t_toga(nlev_toga,nt_toga),q_toga(nlev_toga,nt_toga)
     22        REAL u_toga(nlev_toga,nt_toga),v_toga(nlev_toga,nt_toga)
     23        REAL ht_toga(nlev_toga,nt_toga),vt_toga(nlev_toga,nt_toga)
     24        REAL hq_toga(nlev_toga,nt_toga),vq_toga(nlev_toga,nt_toga)
     25
     26        REAL ts_prof
     27        REAL plev_prof(nlev_toga),w_prof(nlev_toga)
     28        REAL t_prof(nlev_toga),q_prof(nlev_toga)
     29        REAL u_prof(nlev_toga),v_prof(nlev_toga)
     30        REAL ht_prof(nlev_toga),vt_prof(nlev_toga)
     31        REAL hq_prof(nlev_toga),vq_prof(nlev_toga)
     32
     33        REAL w_mod(llm), t_mod(llm),q_mod(llm)
     34        REAL u_mod(llm),v_mod(llm), ht_mod(llm),vt_mod(llm),ug_mod(llm),vg_mod(llm)
     35        REAL hq_mod(llm),vq_mod(llm),qv_mod(llm),ql_mod(llm),qt_mod(llm)
     36        REAL th_mod(llm)
    3737
    3838        !real ts_cur
    … …  
    4141! Declarations specifiques au cas RICO
    4242        character*80 :: fich_rico
    43         integer nlev_rico
     43        INTEGER nlev_rico
    4444
    4545        parameter (nlev_rico=81)
    46         real ts_rico,ps_rico
    47         real w_rico(llm)
    48         real t_rico(llm),q_rico(llm)
    49         real u_rico(llm),v_rico(llm)
    50         real dth_rico(llm)
    51         real dqh_rico(llm)
     46        REAL ts_rico,ps_rico
     47        REAL w_rico(llm)
     48        REAL t_rico(llm),q_rico(llm)
     49        REAL u_rico(llm),v_rico(llm)
     50        REAL dth_rico(llm)
     51        REAL dqh_rico(llm)
    5252!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    5353! Declarations specifiques au cas TWPice
    5454        character*80 :: fich_twpice
    55         integer nlev_twpi, nt_twpi
     55        INTEGER nlev_twpi, nt_twpi
    5656        parameter (nlev_twpi=40, nt_twpi=215)
    57         integer year_ini_twpi, day_ini_twpi, mth_ini_twpi
    58         real heure_ini_twpi
    59         real day_ju_ini_twpi   ! Julian day of twpice first day
     57        INTEGER year_ini_twpi, day_ini_twpi, mth_ini_twpi
     58        REAL heure_ini_twpi
     59        REAL day_ju_ini_twpi   ! Julian day of twpice first day
    6060        parameter (year_ini_twpi=2006)
    6161        parameter (mth_ini_twpi=1)
    6262        parameter (day_ini_twpi=17)  ! 17 = 17Jan2006
    6363        parameter (heure_ini_twpi=10800.) !3h en secondes
    64         real dt_twpi
     64        REAL dt_twpi
    6565        parameter (dt_twpi=3.*3600.)
    6666
    67         real ts_twpi(nt_twpi)
    68         real plev_twpi(nlev_twpi,nt_twpi),w_twpi(nlev_twpi,nt_twpi)
    69         real t_twpi(nlev_twpi,nt_twpi),q_twpi(nlev_twpi,nt_twpi)
    70         real u_twpi(nlev_twpi,nt_twpi),v_twpi(nlev_twpi,nt_twpi)
    71         real ht_twpi(nlev_twpi,nt_twpi),vt_twpi(nlev_twpi,nt_twpi)
    72         real hq_twpi(nlev_twpi,nt_twpi),vq_twpi(nlev_twpi,nt_twpi)
    73 
    74         real ts_proftwp
    75         real plev_proftwp(nlev_twpi),w_proftwp(nlev_twpi)
    76         real t_proftwp(nlev_twpi),q_proftwp(nlev_twpi)
    77         real u_proftwp(nlev_twpi),v_proftwp(nlev_twpi)
    78         real ht_proftwp(nlev_twpi),vt_proftwp(nlev_twpi)
    79         real hq_proftwp(nlev_twpi),vq_proftwp(nlev_twpi)
     67        REAL ts_twpi(nt_twpi)
     68        REAL plev_twpi(nlev_twpi,nt_twpi),w_twpi(nlev_twpi,nt_twpi)
     69        REAL t_twpi(nlev_twpi,nt_twpi),q_twpi(nlev_twpi,nt_twpi)
     70        REAL u_twpi(nlev_twpi,nt_twpi),v_twpi(nlev_twpi,nt_twpi)
     71        REAL ht_twpi(nlev_twpi,nt_twpi),vt_twpi(nlev_twpi,nt_twpi)
     72        REAL hq_twpi(nlev_twpi,nt_twpi),vq_twpi(nlev_twpi,nt_twpi)
     73
     74        REAL ts_proftwp
     75        REAL plev_proftwp(nlev_twpi),w_proftwp(nlev_twpi)
     76        REAL t_proftwp(nlev_twpi),q_proftwp(nlev_twpi)
     77        REAL u_proftwp(nlev_twpi),v_proftwp(nlev_twpi)
     78        REAL ht_proftwp(nlev_twpi),vt_proftwp(nlev_twpi)
     79        REAL hq_proftwp(nlev_twpi),vq_proftwp(nlev_twpi)
    8080
    8181
    … …  
    8383!Declarations specifiques au cas FIRE
    8484        character*80 :: fich_fire
    85         integer nlev_fire, nt_fire
     85        INTEGER nlev_fire, nt_fire
    8686        parameter (nlev_fire=120, nt_fire=1) 
    87         integer year_ini_fire, day_ini_fire, mth_ini_fire
    88         real heure_ini_fire
     87        INTEGER year_ini_fire, day_ini_fire, mth_ini_fire
     88        REAL heure_ini_fire
    8989        parameter (year_ini_fire=1987)
    9090        parameter (mth_ini_fire=7)
    … …  
    9595!Declarations specifiques au cas GABLS4   (MPL 20141023)
    9696        character*80 :: fich_gabls4
    97         integer nlev_gabls4, nt_gabls4, nsol_gabls4
     97        INTEGER nlev_gabls4, nt_gabls4, nsol_gabls4
    9898        parameter (nlev_gabls4=90, nt_gabls4=37, nsol_gabls4=19) 
    99         integer year_ini_gabls4, day_ini_gabls4, mth_ini_gabls4
    100         real heure_ini_gabls4
    101         real day_ju_ini_gabls4   ! Julian day of gabls4 first day
     99        INTEGER year_ini_gabls4, day_ini_gabls4, mth_ini_gabls4
     100        REAL heure_ini_gabls4
     101        REAL day_ju_ini_gabls4   ! Julian day of gabls4 first day
    102102        parameter (year_ini_gabls4=2009)
    103103        parameter (mth_ini_gabls4=12)
    104104        parameter (day_ini_gabls4=11)  ! 11 = 11 decembre 2009
    105105        parameter (heure_ini_gabls4=0.) !0UTC en secondes
    106         real dt_gabls4
     106        REAL dt_gabls4
    107107        parameter (dt_gabls4=3600.) ! 1 forcage ttes les heures
    108108
    109109!profils initiaux:
    110         real plev_gabls4(nlev_gabls4)
    111         real zz_gabls4(nlev_gabls4)
    112         real th_gabls4(nlev_gabls4),t_gabls4(nlev_gabls4),qv_gabls4(nlev_gabls4)
    113         real u_gabls4(nlev_gabls4), v_gabls4(nlev_gabls4)
    114         real depth_sn_gabls4(nsol_gabls4),tsnow_gabls4(nsol_gabls4),snow_dens_gabls4(nsol_gabls4)
    115         real t_gabi(nlev_gabls4),qv_gabi(nlev_gabls4)
    116         real u_gabi(nlev_gabls4), v_gabi(nlev_gabls4),ug_gabi(nlev_gabls4), vg_gabi(nlev_gabls4)
    117         real ht_gabi(nlev_gabls4),hq_gabi(nlev_gabls4),poub(nlev_gabls4)
     110        REAL plev_gabls4(nlev_gabls4)
     111        REAL zz_gabls4(nlev_gabls4)
     112        REAL th_gabls4(nlev_gabls4),t_gabls4(nlev_gabls4),qv_gabls4(nlev_gabls4)
     113        REAL u_gabls4(nlev_gabls4), v_gabls4(nlev_gabls4)
     114        REAL depth_sn_gabls4(nsol_gabls4),tsnow_gabls4(nsol_gabls4),snow_dens_gabls4(nsol_gabls4)
     115        REAL t_gabi(nlev_gabls4),qv_gabi(nlev_gabls4)
     116        REAL u_gabi(nlev_gabls4), v_gabi(nlev_gabls4),ug_gabi(nlev_gabls4), vg_gabi(nlev_gabls4)
     117        REAL ht_gabi(nlev_gabls4),hq_gabi(nlev_gabls4),poub(nlev_gabls4)
    118118       
    119119!forcings
    120         real ht_gabls4(nlev_gabls4,nt_gabls4),hq_gabls4(nlev_gabls4,nt_gabls4)
    121         real ug_gabls4(nlev_gabls4,nt_gabls4),vg_gabls4(nlev_gabls4,nt_gabls4)
    122         real tg_gabls4(nt_gabls4)
    123         real ht_profg(nlev_gabls4),hq_profg(nlev_gabls4)
    124         real ug_profg(nlev_gabls4),vg_profg(nlev_gabls4)
    125         real tg_profg
     120        REAL ht_gabls4(nlev_gabls4,nt_gabls4),hq_gabls4(nlev_gabls4,nt_gabls4)
     121        REAL ug_gabls4(nlev_gabls4,nt_gabls4),vg_gabls4(nlev_gabls4,nt_gabls4)
     122        REAL tg_gabls4(nt_gabls4)
     123        REAL ht_profg(nlev_gabls4),hq_profg(nlev_gabls4)
     124        REAL ug_profg(nlev_gabls4),vg_profg(nlev_gabls4)
     125        REAL tg_profg
    126126         
    127127!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    129129!Declarations specifiques au cas DICE     (MPL 02072013)
    130130        character*80 :: fich_dice
    131         integer nlev_dice, nt_dice
     131        INTEGER nlev_dice, nt_dice
    132132        parameter (nlev_dice=70, nt_dice=145) 
    133         integer year_ini_dice, day_ini_dice, mth_ini_dice
    134         real heure_ini_dice
    135         real day_ju_ini_dice   ! Julian day of dice first day
     133        INTEGER year_ini_dice, day_ini_dice, mth_ini_dice
     134        REAL heure_ini_dice
     135        REAL day_ju_ini_dice   ! Julian day of dice first day
    136136        parameter (year_ini_dice=1999)
    137137        parameter (mth_ini_dice=10)
    138138        parameter (day_ini_dice=23)  ! 23 = 23 october 1999
    139139        parameter (heure_ini_dice=68400.) !19UTC en secondes
    140         real dt_dice
     140        REAL dt_dice
    141141        parameter (dt_dice=0.5*3600.) ! 1 forcage ttes les demi-heures
    142142
    143143!profils initiaux:
    144         real plev_dice(nlev_dice)
    145        
    146         real zz_dice(nlev_dice)
    147         real t_dice(nlev_dice),qv_dice(nlev_dice)
    148         real u_dice(nlev_dice), v_dice(nlev_dice),o3_dice(nlev_dice)
    149         real ht_dice(nlev_dice,nt_dice)
    150         real hq_dice(nlev_dice,nt_dice), hu_dice(nlev_dice,nt_dice)
    151         real hv_dice(nlev_dice,nt_dice)
    152         real w_dice(nlev_dice,nt_dice),omega_dice(nlev_dice,nt_dice)
    153         real o3_mod(llm),hu_mod(llm),hv_mod(llm)
    154         real t_dicei(nlev_dice),qv_dicei(nlev_dice)
    155         real u_dicei(nlev_dice), v_dicei(nlev_dice),o3_dicei(nlev_dice)
    156         real ht_dicei(nlev_dice)
    157         real hq_dicei(nlev_dice), hu_dicei(nlev_dice)
    158         real hv_dicei(nlev_dice)
    159         real w_dicei(nlev_dice),omega_dicei(nlev_dice)
     144        REAL plev_dice(nlev_dice)
     145       
     146        REAL zz_dice(nlev_dice)
     147        REAL t_dice(nlev_dice),qv_dice(nlev_dice)
     148        REAL u_dice(nlev_dice), v_dice(nlev_dice),o3_dice(nlev_dice)
     149        REAL ht_dice(nlev_dice,nt_dice)
     150        REAL hq_dice(nlev_dice,nt_dice), hu_dice(nlev_dice,nt_dice)
     151        REAL hv_dice(nlev_dice,nt_dice)
     152        REAL w_dice(nlev_dice,nt_dice),omega_dice(nlev_dice,nt_dice)
     153        REAL o3_mod(llm),hu_mod(llm),hv_mod(llm)
     154        REAL t_dicei(nlev_dice),qv_dicei(nlev_dice)
     155        REAL u_dicei(nlev_dice), v_dicei(nlev_dice),o3_dicei(nlev_dice)
     156        REAL ht_dicei(nlev_dice)
     157        REAL hq_dicei(nlev_dice), hu_dicei(nlev_dice)
     158        REAL hv_dicei(nlev_dice)
     159        REAL w_dicei(nlev_dice),omega_dicei(nlev_dice)
    160160
    161161       
    162162!forcings
    163         real shf_dice(nt_dice),lhf_dice(nt_dice)
    164         real lwup_dice(nt_dice),swup_dice(nt_dice)
    165         real tg_dice(nt_dice),ustar_dice(nt_dice),psurf_dice(nt_dice)
    166         real ug_dice(nt_dice),vg_dice(nt_dice)
    167 
    168         real shf_prof,lhf_prof,lwup_prof,swup_prof,tg_prof
    169         real ustar_prof,psurf_prof,cdrag
    170         real ht_profd(nlev_dice),hq_profd(nlev_dice),hu_profd(nlev_dice)
    171         real hv_profd(nlev_dice),w_profd(nlev_dice)
    172         real omega_profd(nlev_dice),ug_profd,vg_profd
     163        REAL shf_dice(nt_dice),lhf_dice(nt_dice)
     164        REAL lwup_dice(nt_dice),swup_dice(nt_dice)
     165        REAL tg_dice(nt_dice),ustar_dice(nt_dice),psurf_dice(nt_dice)
     166        REAL ug_dice(nt_dice),vg_dice(nt_dice)
     167
     168        REAL shf_prof,lhf_prof,lwup_prof,swup_prof,tg_prof
     169        REAL ustar_prof,psurf_prof,cdrag
     170        REAL ht_profd(nlev_dice),hq_profd(nlev_dice),hu_profd(nlev_dice)
     171        REAL hv_profd(nlev_dice),w_profd(nlev_dice)
     172        REAL omega_profd(nlev_dice),ug_profd,vg_profd
    173173
    174174!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    183183        real  Ts_gcssold
    184184        real  dtime_frcg
    185         logical :: Turb_fcg_gcssold
     185        LOGICAL :: Turb_fcg_gcssold
    186186
    187187        common /turb_forcing/                                                   &
    … …  
    192192
    193193
    194         integer nlev_armcu, nt_armcu
     194        INTEGER nlev_armcu, nt_armcu
    195195        parameter (nlev_armcu=40, nt_armcu=31)
    196         integer year_ini_armcu, day_ini_armcu, mth_ini_armcu
     196        INTEGER year_ini_armcu, day_ini_armcu, mth_ini_armcu
    197197        real  heure_ini_armcu
    198         real day_ju_ini_armcu                                ! Julian day of armcu case first day
     198        REAL day_ju_ini_armcu                                ! Julian day of armcu case first day
    199199        parameter (year_ini_armcu=1997)
    200200        parameter (mth_ini_armcu=6)
    201201        parameter (day_ini_armcu=21)  ! 172 = 21 juin 1997
    202202        parameter (heure_ini_armcu=41400)   ! 11:30 en secondes
    203         real dt_armcu
     203        REAL dt_armcu
    204204        parameter (dt_armcu=1.*1800.)   ! forcages donnes ttes les demi-heures par ifa_armcu.txt
    205         real sens_armcu(nt_armcu),flat_armcu(nt_armcu)
    206         real adv_theta_armcu(nt_armcu),rad_theta_armcu(nt_armcu)
    207         real adv_qt_armcu(nt_armcu)
    208         real theta_mod(llm),rv_mod(llm),play_mod(llm)
     205        REAL sens_armcu(nt_armcu),flat_armcu(nt_armcu)
     206        REAL adv_theta_armcu(nt_armcu),rad_theta_armcu(nt_armcu)
     207        REAL adv_qt_armcu(nt_armcu)
     208        REAL theta_mod(llm),rv_mod(llm),play_mod(llm)
    209209! profc comme "profil armcu"
    210210       
    211211! forcages interpoles dans le temps
    212         real adv_theta_prof,rad_theta_prof,adv_qt_prof
    213         real sens_prof,flat_prof,fact
     212        REAL adv_theta_prof,rad_theta_prof,adv_qt_prof
     213        REAL sens_prof,flat_prof,fact
    214214!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    215215! declarations specifiques au cas Sandu
    … …  
    217217!        integer nlev_prof
    218218!        parameter (nlev_prof = 41)
    219         integer nlev_sandu, nt_sandu
     219        INTEGER nlev_sandu, nt_sandu
    220220        parameter (nlev_sandu=87, nt_sandu=13)
    221         integer year_ini_sandu, day_ini_sandu, mth_ini_sandu
    222         real day_ju_ini_sandu                                ! Julian day of sandu case first day
     221        INTEGER year_ini_sandu, day_ini_sandu, mth_ini_sandu
     222        REAL day_ju_ini_sandu                                ! Julian day of sandu case first day
    223223        parameter (year_ini_sandu=2006)
    224224        parameter (mth_ini_sandu=7)
    225225        parameter (day_ini_sandu=15)  ! 196 = 15 juillet 2006
    226         real dt_sandu, tau_sandu
     226        REAL dt_sandu, tau_sandu
    227227        logical  :: trouve_700=.TRUE.
    228228        parameter (dt_sandu=6.*3600.)   ! forcages donnes ttes les 6 heures par ifa_sandu.txt
    229229        parameter (tau_sandu=30000*3600.)  ! temps de relaxation u,v,thetal,qt vers profil init et au dessus 700hPa
    230230!!
    231         real ts_sandu(nt_sandu)
     231        REAL ts_sandu(nt_sandu)
    232232! profs comme "profil sandu"
    233         real plev_profs(nlev_sandu)
    234         real t_profs(nlev_sandu),thl_profs(nlev_sandu)
    235         real q_profs(nlev_sandu)
    236         real u_profs(nlev_sandu),v_profs(nlev_sandu),w_profs(nlev_sandu)
    237         real omega_profs(nlev_sandu),o3mmr_profs(nlev_sandu)
    238 
    239         real, dimension(llm) :: relax_u,relax_v,relax_thl
    240         real, dimension(llm,2) :: relax_q
    241 
    242         real thl_mod(llm),omega_mod(llm),o3mmr_mod(llm),tke_mod(llm)
     233        REAL plev_profs(nlev_sandu)
     234        REAL t_profs(nlev_sandu),thl_profs(nlev_sandu)
     235        REAL q_profs(nlev_sandu)
     236        REAL u_profs(nlev_sandu),v_profs(nlev_sandu),w_profs(nlev_sandu)
     237        REAL omega_profs(nlev_sandu),o3mmr_profs(nlev_sandu)
     238
     239        REAL, DIMENSION(llm) :: relax_u,relax_v,relax_thl
     240        REAL, DIMENSION(llm,2) :: relax_q
     241
     242        REAL thl_mod(llm),omega_mod(llm),o3mmr_mod(llm),tke_mod(llm)
    243243!vertical advection computation
    244         real d_t_z(llm),d_th_z(llm), d_q_z(llm)
    245         real d_t_dyn_z(llm),d_th_dyn_z(llm), d_q_dyn_z(llm)
    246         real d_u_z(llm),d_v_z(llm)
    247         real d_u_dyn(llm),d_v_dyn(llm)
    248         real d_u_dyn_z(llm),d_v_dyn_z(llm)
    249         real d_u_adv(llm),d_v_adv(llm)
    250         real zz(llm)
    251         real zfact
     244        REAL d_t_z(llm),d_th_z(llm), d_q_z(llm)
     245        REAL d_t_dyn_z(llm),d_th_dyn_z(llm), d_q_dyn_z(llm)
     246        REAL d_u_z(llm),d_v_z(llm)
     247        REAL d_u_dyn(llm),d_v_dyn(llm)
     248        REAL d_u_dyn_z(llm),d_v_dyn_z(llm)
     249        REAL d_u_adv(llm),d_v_adv(llm)
     250        REAL zz(llm)
     251        REAL zfact
    252252!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    253253! Declarations specifiques au cas Astex
    254254        character*80 :: fich_astex
    255         integer nlev_astex, nt_astex
     255        INTEGER nlev_astex, nt_astex
    256256        parameter (nlev_astex=34, nt_astex=49)
    257         integer year_ini_astex, day_ini_astex, mth_ini_astex
    258         real day_ju_ini_astex                                ! Julian day of astex case first day
     257        INTEGER year_ini_astex, day_ini_astex, mth_ini_astex
     258        REAL day_ju_ini_astex                                ! Julian day of astex case first day
    259259        parameter (year_ini_astex=1992)
    260260        parameter (mth_ini_astex=6)
    261261        parameter (day_ini_astex=13)  ! 165 = 13 juin 1992
    262         real dt_astex
     262        REAL dt_astex
    263263        parameter (dt_astex=3600.)    ! forcages donnes ttes les heures par ifa_astex.txt
    264         real ts_astex(nt_astex),div_astex(nt_astex),ug_astex(nt_astex)
    265         real vg_astex(nt_astex),ufa_astex(nt_astex),vfa_astex(nt_astex)
    266         real div_prof,ug_prof,vg_prof,ufa_prof,vfa_prof
     264        REAL ts_astex(nt_astex),div_astex(nt_astex),ug_astex(nt_astex)
     265        REAL vg_astex(nt_astex),ufa_astex(nt_astex),vfa_astex(nt_astex)
     266        REAL div_prof,ug_prof,vg_prof,ufa_prof,vfa_prof
    267267! profa comme "profil astex"
    268         real plev_profa(nlev_astex)
    269         real t_profa(nlev_astex),thl_profa(nlev_astex)
    270         real qv_profa(nlev_astex),ql_profa(nlev_astex)
    271         real qt_profa(nlev_astex),o3mmr_profa(nlev_astex)
    272         real u_profa(nlev_astex),v_profa(nlev_astex),w_profa(nlev_astex)
    273         real tke_profa(nlev_astex)
     268        REAL plev_profa(nlev_astex)
     269        REAL t_profa(nlev_astex),thl_profa(nlev_astex)
     270        REAL qv_profa(nlev_astex),ql_profa(nlev_astex)
     271        REAL qt_profa(nlev_astex),o3mmr_profa(nlev_astex)
     272        REAL u_profa(nlev_astex),v_profa(nlev_astex),w_profa(nlev_astex)
     273        REAL tke_profa(nlev_astex)
    274274
    275275!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    276276!Declarations specifiques au cas standard
    277277
    278         real w_mod_cas(llm), t_mod_cas(llm),q_mod_cas(llm)
    279         real theta_mod_cas(llm),thl_mod_cas(llm),thv_mod_cas(llm)
    280         real qv_mod_cas(llm),ql_mod_cas(llm),qi_mod_cas(llm)
    281         real ug_mod_cas(llm),vg_mod_cas(llm)
    282         real u_mod_cas(llm),v_mod_cas(llm)
    283         real omega_mod_cas(llm)
    284         real ht_mod_cas(llm),vt_mod_cas(llm),dt_mod_cas(llm),dtrad_mod_cas(llm)
    285         real hth_mod_cas(llm),vth_mod_cas(llm),dth_mod_cas(llm)
    286         real hq_mod_cas(llm),vq_mod_cas(llm),dq_mod_cas(llm)
    287         real hu_mod_cas(llm),vu_mod_cas(llm),du_mod_cas(llm)
    288         real hv_mod_cas(llm),vv_mod_cas(llm),dv_mod_cas(llm)
    289         integer day_ini_cas
    290 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    291 
    292 
     278        REAL w_mod_cas(llm), t_mod_cas(llm),q_mod_cas(llm)
     279        REAL theta_mod_cas(llm),thl_mod_cas(llm),thv_mod_cas(llm)
     280        REAL qv_mod_cas(llm),ql_mod_cas(llm),qi_mod_cas(llm)
     281        REAL ug_mod_cas(llm),vg_mod_cas(llm)
     282        REAL u_mod_cas(llm),v_mod_cas(llm)
     283        REAL omega_mod_cas(llm)
     284        REAL ht_mod_cas(llm),vt_mod_cas(llm),dt_mod_cas(llm),dtrad_mod_cas(llm)
     285        REAL hth_mod_cas(llm),vth_mod_cas(llm),dth_mod_cas(llm)
     286        REAL hq_mod_cas(llm),vq_mod_cas(llm),dq_mod_cas(llm)
     287        REAL hu_mod_cas(llm),vu_mod_cas(llm),du_mod_cas(llm)
     288        REAL hv_mod_cas(llm),vv_mod_cas(llm),dv_mod_cas(llm)
     289        INTEGER day_ini_cas
     290!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     291
     292

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_1D_interp_cases.h

    r5116 r5117  
    55! Forcing_LES case: constant dq_dyn
    66!---------------------------------------------------------------------
    7       if (forcing_LES) THEN
     7      IF (forcing_LES) THEN
    88        DO l = 1,llm
    99          d_q_adv(l,1) = dq_dyn(l,1)
    … …  
    1414! Interpolation forcing in time and onto model levels
    1515!---------------------------------------------------------------------
    16       if (forcing_GCSSold) THEN
     16      IF (forcing_GCSSold) THEN
    1717       CALL get_uvd(it,timestep,fich_gcssold_ctl,fich_gcssold_dat,              &
    1818     &               ht_gcssold,hq_gcssold,hw_gcssold,                          &
    … …  
    2121     &               imp_fcg_gcssold,ts_fcg_gcssold,                            &
    2222     &               Tp_fcg_gcssold,Turb_fcg_gcssold)
    23        if (prt_level.ge.1) THEN
     23       IF (prt_level.ge.1) THEN
    2424         print *,' get_uvd -> hqturb_gcssold ',it,hqturb_gcssold
    2525       endif
    … …  
    4646! Interpolation Toga forcing
    4747!---------------------------------------------------------------------
    48       if (forcing_toga) THEN
    49        if (prt_level.ge.1) THEN
     48      IF (forcing_toga) THEN
     49       IF (prt_level.ge.1) THEN
    5050        PRINT*,                                                             &
    5151     & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_toga=',     &
    … …  
    6161     &             ,ht_prof,vt_prof,hq_prof,vq_prof)
    6262! EV: tg instead of ts_cur
    63         if (type_ts_forcing.eq.1) tg = ts_prof !
     63        IF (type_ts_forcing.EQ.1) tg = ts_prof !
    6464
    6565! vertical interpolation:
    … …  
    9191! Interpolation DICE forcing
    9292!---------------------------------------------------------------------
    93       if (forcing_dice) THEN
    94        if (prt_level.ge.1) THEN
     93      IF (forcing_dice) THEN
     94       IF (prt_level.ge.1) THEN
    9595        PRINT*,'#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_dice=',&
    9696     &    day,day1,(day-day1)*86400.,(day-day1)*86400/dt_dice
    … …  
    111111!     enddo
    112112! EV tg instead of ts_cur
    113         if (type_ts_forcing.eq.1) tg = tg_prof ! SST used
     113        IF (type_ts_forcing.EQ.1) tg = tg_prof ! SST used
    114114
    115115! vertical interpolation:
    … …  
    191191! Interpolation gabls4 forcing
    192192!---------------------------------------------------------------------
    193       if (forcing_gabls4 ) THEN
    194        if (prt_level.ge.1) THEN
     193      IF (forcing_gabls4 ) THEN
     194       IF (prt_level.ge.1) THEN
    195195        PRINT*,'#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_gabls4=',&
    196196     &    day,day1,(day-day1)*86400.,(day-day1)*86400/dt_gabls4
    … …  
    203203     &             ,ug_profg,vg_profg,ht_profg,hq_profg,tg_profg)
    204204!EV tg instead of ts_cur
    205         if (type_ts_forcing.eq.1) tg = tg_prof ! SST used
     205        IF (type_ts_forcing.EQ.1) tg = tg_prof ! SST used
    206206
    207207! vertical interpolation:
    … …  
    232232! Interpolation forcing TWPice
    233233!---------------------------------------------------------------------
    234       if (forcing_twpice) THEN
     234      IF (forcing_twpice) THEN
    235235        PRINT*,                                                             &
    236236     & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_twpi=',     &
    … …  
    277277!wind nudging above 500m with a 2h time scale
    278278        do l=1,llm
    279         if (nudge_wind) THEN
     279        IF (nudge_wind) THEN
    280280!           if (phi(l).gt.5000.) THEN
    281         if (phi(l).gt.0.) THEN
     281        IF (phi(l).gt.0.) THEN
    282282        u(l)=u(l)+timestep*(u_mod(l)-u(l))/(2.*3600.)
    283283        v(l)=v(l)+timestep*(v_mod(l)-v(l))/(2.*3600.)
    … …  
    290290
    291291!CR:nudging of q and theta with a 6h time scale above 15km
    292         if (nudge_thermo) THEN
     292        IF (nudge_thermo) THEN
    293293        do l=1,llm
    294294           zz(l)=phi(l)/9.8
    295            if ((zz(l).le.16000.).and.(zz(l).gt.15000.)) THEN
     295           IF ((zz(l).le.16000.).AND.(zz(l).gt.15000.)) THEN
    296296             zfact=(zz(l)-15000.)/1000.
    297297        q(l,1)=q(l,1)+timestep*(q_mod(l)-q(l,1))/(6.*3600.)*zfact
    298298        temp(l)=temp(l)+timestep*(t_mod(l)-temp(l))/(6.*3600.)*zfact
    299            else if (zz(l).gt.16000.) THEN
     299           ELSE IF (zz(l).gt.16000.) THEN
    300300        q(l,1)=q(l,1)+timestep*(q_mod(l)-q(l,1))/(6.*3600.)
    301301        temp(l)=temp(l)+timestep*(t_mod(l)-temp(l))/(6.*3600.)
    … …  
    309309       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
    310310!calcul de l'advection totale
    311         if (cptadvw) THEN
     311        IF (cptadvw) THEN
    312312        d_t_adv(l) = alpha*omega(l)/rcpd+ht_mod(l)-d_t_dyn_z(l)
    313313!        PRINT*,'temp vert adv',l,ht_mod(l),vt_mod(l),-d_t_dyn_z(l)
    … …  
    328328!---------------------------------------------------------------------
    329329
    330        if (forcing_amma) THEN
     330       IF (forcing_amma) THEN
    331331        PRINT*,                                                             &
    332332     & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_amma=',     &
    … …  
    410410! Interpolation forcing Rico
    411411!---------------------------------------------------------------------
    412       if (forcing_rico) THEN
     412      IF (forcing_rico) THEN
    413413!      CALL lstendH(llm,omega,dt_dyn,dq_dyn,du_dyn, dv_dyn,q,temp,u,v,play)
    414414       CALL lstendH(llm,nqtot,omega,dt_dyn,dq_dyn,q,temp,u,v,play)
    … …  
    424424! Interpolation forcing Arm_cu
    425425!---------------------------------------------------------------------
    426       if (forcing_armcu) THEN
     426      IF (forcing_armcu) THEN
    427427        PRINT*,                                                             &
    428428     & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_armcu=',    &
    … …  
    479479! Interpolation forcing in time and onto model levels
    480480!---------------------------------------------------------------------
    481       if (forcing_sandu) THEN
     481      IF (forcing_sandu) THEN
    482482        PRINT*,                                                             &
    483483     & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_sandu=',    &
    … …  
    492492     &             ,ts_sandu,ts_prof)
    493493! EV tg instead of ts_cur
    494         if (type_ts_forcing.eq.1) tg = ts_prof ! SST used in read_tsurf1d
     494        IF (type_ts_forcing.EQ.1) tg = ts_prof ! SST used in read_tsurf1d
    495495
    496496! vertical interpolation:
    … …  
    560560! Interpolation forcing in time and onto model levels
    561561!---------------------------------------------------------------------
    562       if (forcing_astex) THEN
     562      IF (forcing_astex) THEN
    563563        PRINT*,                                                             &
    564564     & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_astex=',    &
    … …  
    574574     &             ,ufa_prof,vfa_prof)
    575575! EV tg instead of ts_cur
    576         if (type_ts_forcing.eq.1) tg = ts_prof ! SST used
     576        IF (type_ts_forcing.EQ.1) tg = ts_prof ! SST used
    577577! vertical interpolation:
    578578      CALL interp_astex_vertical(play,nlev_astex,plev_profa                 &
    … …  
    642642! Interpolation forcing standard case
    643643!---------------------------------------------------------------------
    644       if (forcing_case) THEN
     644      IF (forcing_case) THEN
    645645         PRINT*,'FORCING CASE forcing_case'
    646646
    … …  
    714714
    715715!wind nudging
    716       if (nudge_u.gt.0.) THEN
     716      IF (nudge_u.gt.0.) THEN
    717717        do l=1,llm
    718718           u(l)=u(l)+timestep*(u_mod_cas(l)-u(l))/(nudge_u)
    … …  
    724724      endif
    725725
    726       if (nudge_v.gt.0.) THEN
     726      IF (nudge_v.gt.0.) THEN
    727727        do l=1,llm
    728728           v(l)=v(l)+timestep*(v_mod_cas(l)-v(l))/(nudge_v)
    … …  
    734734      endif
    735735
    736       if (nudge_w.gt.0.) THEN
     736      IF (nudge_w.gt.0.) THEN
    737737        do l=1,llm
    738738           w(l)=w(l)+timestep*(w_mod_cas(l)-w(l))/(nudge_w)
    … …  
    745745
    746746!nudging of q and temp
    747       if (nudge_t.gt.0.) THEN
     747      IF (nudge_t.gt.0.) THEN
    748748        do l=1,llm
    749749           temp(l)=temp(l)+timestep*(t_mod_cas(l)-temp(l))/(nudge_t)
    750750        enddo
    751751      endif
    752       if (nudge_q.gt.0.) THEN
     752      IF (nudge_q.gt.0.) THEN
    753753        do l=1,llm
    754754           q(l,1)=q(l,1)+timestep*(q_mod_cas(l)-q(l,1))/(nudge_q)
    … …  
    762762
    763763!calcul advection
    764         if ((tend_u.eq.1).and.(tend_w.eq.0)) THEN
     764        IF ((tend_u.EQ.1).AND.(tend_w.EQ.0)) THEN
    765765           d_u_adv(l)=du_mod_cas(l)
    766         else if ((tend_u.eq.1).and.(tend_w.eq.1)) THEN
     766        ELSE IF ((tend_u.EQ.1).AND.(tend_w.EQ.1)) THEN
    767767           d_u_adv(l)=hu_mod_cas(l)-d_u_dyn_z(l)
    768768        endif
    769769
    770         if ((tend_v.eq.1).and.(tend_w.eq.0)) THEN
     770        IF ((tend_v.EQ.1).AND.(tend_w.EQ.0)) THEN
    771771           d_v_adv(l)=dv_mod_cas(l)
    772         else if ((tend_v.eq.1).and.(tend_w.eq.1)) THEN
     772        ELSE IF ((tend_v.EQ.1).AND.(tend_w.EQ.1)) THEN
    773773           d_v_adv(l)=hv_mod_cas(l)-d_v_dyn_z(l)
    774774        endif
    775775
    776         if ((tend_t.eq.1).and.(tend_w.eq.0)) THEN
     776        IF ((tend_t.EQ.1).AND.(tend_w.EQ.0)) THEN
    777777!           d_t_adv(l)=alpha*omega(l)/rcpd+dt_mod_cas(l)
    778778           d_t_adv(l)=alpha*omega(l)/rcpd-dt_mod_cas(l)
    779         else if ((tend_t.eq.1).and.(tend_w.eq.1)) THEN
     779        ELSE IF ((tend_t.EQ.1).AND.(tend_w.EQ.1)) THEN
    780780!           d_t_adv(l)=alpha*omega(l)/rcpd+ht_mod_cas(l)-d_t_dyn_z(l)
    781781           d_t_adv(l)=alpha*omega(l)/rcpd-ht_mod_cas(l)-d_t_dyn_z(l)
    782782        endif
    783783
    784         if ((tend_q.eq.1).and.(tend_w.eq.0)) THEN
     784        IF ((tend_q.EQ.1).AND.(tend_w.EQ.0)) THEN
    785785!           d_q_adv(l,1)=dq_mod_cas(l)
    786786           d_q_adv(l,1)=-1*dq_mod_cas(l)
    787         else if ((tend_q.eq.1).and.(tend_w.eq.1)) THEN
     787        ELSE IF ((tend_q.EQ.1).AND.(tend_w.EQ.1)) THEN
    788788!           d_q_adv(l,1)=hq_mod_cas(l)-d_q_dyn_z(l)
    789789           d_q_adv(l,1)=-1*hq_mod_cas(l)-d_q_dyn_z(l)
    790790        endif
    791791         
    792         if (tend_rayo.eq.1) THEN
     792        IF (tend_rayo.EQ.1) THEN
    793793           dt_cooling(l) = dtrad_mod_cas(l)
    794794!          print *,'dt_cooling=',dt_cooling(l)
    … …  
    814814! Interpolation forcing standard case
    815815!---------------------------------------------------------------------
    816       if (forcing_case2 .OR. forcing_SCM) THEN
     816      IF (forcing_case2 .OR. forcing_SCM) THEN
    817817         PRINT*,'FORCING CASE forcing_case2'
    818818        PRINT*,                                                             &
    … …  
    904904
    905905!geostrophic wind
    906       if (forc_geo.eq.1) THEN
     906      IF (forc_geo.EQ.1) THEN
    907907        do l=1,llm
    908908        ug(l) = ug_mod_cas(l)
    … …  
    911911      endif
    912912!wind nudging
    913       if (nudging_u.gt.0.) THEN
     913      IF (nudging_u.gt.0.) THEN
    914914        do l=1,llm
    915915           u(l)=u(l)+timestep*(u_mod_cas(l)-u(l))/(nudge_u)
    … …  
    921921      endif
    922922
    923       if (nudging_v.gt.0.) THEN
     923      IF (nudging_v.gt.0.) THEN
    924924        do l=1,llm
    925925           v(l)=v(l)+timestep*(v_mod_cas(l)-v(l))/(nudge_v)
    … …  
    931931      endif
    932932
    933       if (nudging_w.gt.0.) THEN
     933      IF (nudging_w.gt.0.) THEN
    934934        do l=1,llm
    935935           w(l)=w(l)+timestep*(w_mod_cas(l)-w(l))/(nudge_w)
    … …  
    942942
    943943!nudging of q and temp
    944       if (nudging_t.gt.0.) THEN
     944      IF (nudging_t.gt.0.) THEN
    945945        do l=1,llm
    946946           temp(l)=temp(l)+timestep*(t_mod_cas(l)-temp(l))/(nudge_t)
    947947        enddo
    948948      endif
    949       if (nudging_qv.gt.0.) THEN
     949      IF (nudging_qv.gt.0.) THEN
    950950        do l=1,llm
    951951           q(l,1)=q(l,1)+timestep*(q_mod_cas(l)-q(l,1))/(nudge_q)
    … …  
    960960
    961961!calcul advections
    962         if ((forc_u.eq.1).and.(forc_w.eq.0)) THEN
     962        IF ((forc_u.EQ.1).AND.(forc_w.EQ.0)) THEN
    963963           d_u_adv(l)=du_mod_cas(l)
    964         else if ((forc_u.eq.1).and.(forc_w.eq.1)) THEN
     964        ELSE IF ((forc_u.EQ.1).AND.(forc_w.EQ.1)) THEN
    965965           d_u_adv(l)=hu_mod_cas(l)-d_u_dyn_z(l)
    966966        endif
    967967
    968         if ((forc_v.eq.1).and.(forc_w.eq.0)) THEN
     968        IF ((forc_v.EQ.1).AND.(forc_w.EQ.0)) THEN
    969969           d_v_adv(l)=dv_mod_cas(l)
    970         else if ((forc_v.eq.1).and.(forc_w.eq.1)) THEN
     970        ELSE IF ((forc_v.EQ.1).AND.(forc_w.EQ.1)) THEN
    971971           d_v_adv(l)=hv_mod_cas(l)-d_v_dyn_z(l)
    972972        endif
    … …  
    974974! Puisque dth a ete converti en dt, on traite de la meme facon
    975975! les flags tadv et thadv
    976         if ((tadv.eq.1.or.thadv.eq.1) .and. (forc_w.eq.0)) THEN
     976        IF ((tadv.EQ.1.OR.thadv.EQ.1) .AND. (forc_w.EQ.0)) THEN
    977977!          d_t_adv(l)=alpha*omega(l)/rcpd-dt_mod_cas(l)
    978978           d_t_adv(l)=alpha*omega(l)/rcpd+dt_mod_cas(l)
    979         else if ((tadv.eq.1.or.thadv.eq.1) .and. (forc_w.eq.1)) THEN
     979        ELSE IF ((tadv.EQ.1.OR.thadv.EQ.1) .AND. (forc_w.EQ.1)) THEN
    980980!          d_t_adv(l)=alpha*omega(l)/rcpd-ht_mod_cas(l)-d_t_dyn_z(l)
    981981           d_t_adv(l)=alpha*omega(l)/rcpd+ht_mod_cas(l)-d_t_dyn_z(l)
    982982        endif
    983983
    984 !       if ((thadv.eq.1) .and. (forc_w.eq.0)) THEN
     984!       if ((thadv.EQ.1) .AND. (forc_w.EQ.0)) THEN
    985985!          d_t_adv(l)=alpha*omega(l)/rcpd-dth_mod_cas(l)
    986986!          d_t_adv(l)=alpha*omega(l)/rcpd+dth_mod_cas(l)
    987 !       else if ((thadv.eq.1) .and. (forc_w.eq.1)) THEN
     987!       ELSE IF ((thadv.EQ.1) .AND. (forc_w.EQ.1)) THEN
    988988!          d_t_adv(l)=alpha*omega(l)/rcpd-hth_mod_cas(l)-d_t_dyn_z(l)
    989989!          d_t_adv(l)=alpha*omega(l)/rcpd+hth_mod_cas(l)-d_t_dyn_z(l)
    990990!       endif
    991991
    992         if ((qadv.eq.1) .and. (forc_w.eq.0)) THEN
     992        IF ((qadv.EQ.1) .AND. (forc_w.EQ.0)) THEN
    993993           d_q_adv(l,1)=dq_mod_cas(l)
    994994!          d_q_adv(l,1)=-1*dq_mod_cas(l)
    995         else if ((qadv.eq.1) .and. (forc_w.eq.1)) THEN
     995        ELSE IF ((qadv.EQ.1) .AND. (forc_w.EQ.1)) THEN
    996996           d_q_adv(l,1)=hq_mod_cas(l)-d_q_dyn_z(l)
    997997!          d_q_adv(l,1)=-1*hq_mod_cas(l)-d_q_dyn_z(l)
    998998        endif
    999999         
    1000         if (trad.eq.1) THEN
     1000        IF (trad.EQ.1) THEN
    10011001           tend_rayo=1
    10021002           dt_cooling(l) = dtrad_mod_cas(l)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_1D_read_forc_cases.h

    r5116 r5117  
    1111      nq2=0
    1212
    13       if (forcing_les .or. forcing_radconv                                      &
    14      &    .or. forcing_GCSSold .or. forcing_fire) THEN
    15       if (forcing_fire) THEN
     13      IF (forcing_les .OR. forcing_radconv                                      &
     14     &    .OR. forcing_GCSSold .OR. forcing_fire) THEN
     15      IF (forcing_fire) THEN
    1616!----------------------------------------------------------------------
    1717!read fire forcings from fire.nc
    … …  
    5151        ! Above the max altutide of the input file
    5252
    53         if (zlay(l)<height(kmax)) mxcalc=l
     53        IF (zlay(l)<height(kmax)) mxcalc=l
    5454
    5555        frac = (height(kmax)-zlay(l))/(height (kmax)-height(kmax-1))
    5656        ttt =tttprof(kmax)-frac*(tttprof(kmax)-tttprof(kmax-1))
    57        if ((forcing_GCSSold .AND. tp_ini_GCSSold) .OR. forcing_fire)then ! pot. temp. in initial profile
     57       IF ((forcing_GCSSold .AND. tp_ini_GCSSold) .OR. forcing_fire)then ! pot. temp. in initial profile
    5858          temp(l) = ttt*(play(l)/pzero)**rkappa
    5959          teta(l) = ttt
    … …  
    7878          frac = (height(k)-zlay(l))/(height(k)-height(k-1))
    7979          IF(l==1) PRINT*,'k, height, tttprof',k,height(k),tttprof(k)
    80           IF(zlay(l)>height(k-1).and.zlay(l)<height(k)) THEN
     80          IF(zlay(l)>height(k-1).AND.zlay(l)<height(k)) THEN
    8181            ttt =tttprof(k)-frac*(tttprof(k)-tttprof(k-1))
    82        if ((forcing_GCSSold .AND. tp_ini_GCSSold) .OR. forcing_fire)then ! pot. temp. in initial profile
     82       IF ((forcing_GCSSold .AND. tp_ini_GCSSold) .OR. forcing_fire)then ! pot. temp. in initial profile
    8383          temp(l) = ttt*(play(l)/pzero)**rkappa
    8484          teta(l) = ttt
    … …  
    100100          elseif(zlay(l)<height(1)) then ! profils uniformes pour z<height(1)
    101101            ttt =tttprof(1)
    102        if ((forcing_GCSSold .AND. tp_ini_GCSSold) .OR. forcing_fire)then ! pot. temp. in initial profile
     102       IF ((forcing_GCSSold .AND. tp_ini_GCSSold) .OR. forcing_fire)then ! pot. temp. in initial profile
    103103          temp(l) = ttt*(play(l)/pzero)**rkappa
    104104          teta(l) = ttt
    … …  
    121121        temp(l)=max(min(temp(l),350.),150.)
    122122        rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
    123         if (l .lt. llm) THEN
     123        IF (l .lt. llm) THEN
    124124          zlay(l+1) = zlay(l) + (play(l)-play(l+1))/(rg*rho(l))
    125125        endif
    126126        omega2(l)=-rho(l)*omega(l)
    127127        omega(l)= omega(l)*(-rg*rho(l)) !en Pa/s
    128         if (l>1) THEN
     128        IF (l>1) THEN
    129129        IF(zlay(l-1)>height(kmax)) THEN
    130130           omega(l)=0.0
    … …  
    136136      enddo
    137137
    138       endif ! forcing_les .or. forcing_GCSSold .or. forcing_fire
     138      endif ! forcing_les .OR. forcing_GCSSold .OR. forcing_fire
    139139!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    140140!---------------------------------------------------------------------
    141141! Forcing for GCSSold:
    142142!---------------------------------------------------------------------
    143       if (forcing_GCSSold) THEN
     143      IF (forcing_GCSSold) THEN
    144144       fich_gcssold_ctl = './forcing.ctl'
    145145       fich_gcssold_dat = './forcing8.dat'
    … …  
    157157! Forcing for RICO:
    158158!---------------------------------------------------------------------
    159       if (forcing_rico) THEN
     159      IF (forcing_rico) THEN
    160160!       CALL writefield_phy('omega', omega,llm+1)
    161161      fich_rico = 'rico.txt'
    … …  
    185185!---------------------------------------------------------------------
    186186
    187       if (forcing_toga) THEN
     187      IF (forcing_toga) THEN
    188188! read TOGA-COARE forcing (native vertical grid, nt_toga timesteps):
    189189      fich_toga = './d_toga/ifa_toga_coare_v21_dime.txt'
    … …  
    236236!---------------------------------------------------------------------
    237237
    238       if (forcing_twpice) THEN
     238      IF (forcing_twpice) THEN
    239239!read TWP-ICE forcings
    240240     fich_twpice='d_twpi/twp180iopsndgvarana_v2.1_C3.c1.20060117.000000.cdf'
    … …  
    290290!---------------------------------------------------------------------
    291291
    292       if (forcing_amma) THEN
     292      IF (forcing_amma) THEN
    293293      CALL read_1D_cases
    294294
    … …  
    360360!---------------------------------------------------------------------
    361361
    362       if (forcing_dice) THEN
     362      IF (forcing_dice) THEN
    363363!read DICE forcings
    364364      fich_dice='dice_driver.nc'
    … …  
    475475!!!! Si la temperature de surface n'est pas impos??e:
    476476 
    477       if (forcing_gabls4) THEN
     477      IF (forcing_gabls4) THEN
    478478!read GABLS4 forcings
    479479     
    … …  
    586586!---------------------------------------------------------------------
    587587
    588       if (forcing_armcu) THEN
     588      IF (forcing_armcu) THEN
    589589! read armcu forcing :
    590590       WRITE(*,*) 'Avant lecture Forcing Arm_Cu'
    … …  
    685685!---------------------------------------------------------------------
    686686
    687       if (forcing_sandu) THEN
     687      IF (forcing_sandu) THEN
    688688       WRITE(*,*) 'Avant lecture Forcing SANDU'
    689689
    … …  
    759759!---------------------------------------------------------------------
    760760
    761       if (forcing_astex) THEN
     761      IF (forcing_astex) THEN
    762762       WRITE(*,*) 'Avant lecture Forcing Astex'
    763763
    … …  
    835835!---------------------------------------------------------------------
    836836
    837       if (forcing_case) THEN
     837      IF (forcing_case) THEN
    838838         WRITE(*,*) 'avant CALL read_1D_cas'
    839839         CALL read_1D_cas
    … …  
    909909!---------------------------------------------------------------------
    910910
    911       if (forcing_case2) THEN
     911      IF (forcing_case2) THEN
    912912         WRITE(*,*) 'avant CALL read2_1D_cas'
    913913         CALL read2_1D_cas
    … …  
    10071007!---------------------------------------------------------------------
    10081008
    1009       if (forcing_SCM) THEN
     1009      IF (forcing_SCM) THEN
    10101010         WRITE(*,*) 'avant CALL old_read_SCM_cas'
    10111011         CALL old_read_SCM_cas

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/replay1d.F90

    r5116 r5117  
    1818REAL :: rlat_rad(1),rlon_rad(1)
    1919
    20 integer ntime
    21 integer jour0,mois0,an0,day_step,anneeref,dayref
    22 integer klev,klon
     20INTEGER ntime
     21INTEGER jour0,mois0,an0,day_step,anneeref,dayref
     22INTEGER klev,klon
    2323CHARACTER (len=10) :: calend
    2424CHARACTER(len=20) :: calendrier
    … …  
    104104 
    105105      CHARACTER(LEN=*) modname
    106       integer ierr
     106      INTEGER ierr
    107107      CHARACTER(LEN=*) message
    108108 
    … …  
    114114      CALL getin_dump
    115115
    116       if (ierr == 0) THEN
     116      IF (ierr == 0) THEN
    117117        WRITE(*,*) 'Everything is cool'
    118118      else
Note: See TracChangeset for help on using the changeset viewer.