Ignore:
Timestamp:
Jul 29, 2024, 11:01:04 PM (7 weeks ago)
Author:
abarral
Message:

Put YOMCST.h into modules

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

Legend:

Unmodified
Added
Removed

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

    r5143 r5144  
    11721172    !   sans WTG rajouter une advection horizontale
    11731173    !----------------------------------------------------------------------
     1174    USE lmdz_yomcst
     1175
    11741176    IMPLICIT NONE
    1175     include "YOMCST.h"
    11761177    !        argument
    11771178    INTEGER llm
    … …  
    12441245    !   sans WTG rajouter une advection horizontale
    12451246    !----------------------------------------------------------------------
     1247    USE lmdz_yomcst
     1248
    12461249    IMPLICIT NONE
    1247     include "YOMCST.h"
    12481250    !        argument
    12491251    INTEGER llm, nqtot
    … …  
    13181320    ! ========================================================
    13191321    USE dimphy
    1320     USE lmdz_YOETHF
     1322    USE lmdz_yoethf
    13211323    USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
     1324    USE lmdz_yomcst
    13221325
    13231326    IMPLICIT NONE
    … …  
    13371340    INTEGER k, i
    13381341    REAL zx_qs
    1339 
    1340     ! Declaration des constantes et des fonctions thermodynamiques
    1341 
    1342     include "YOMCST.h"
    13431342
    13441343    DO k = 1, klev
    … …  
    13941393    ! ========================================================
    13951394    USE dimphy
    1396     USE lmdz_YOETHF
     1395    USE lmdz_yoethf
    13971396    USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
     1397    USE lmdz_yomcst
    13981398
    13991399    IMPLICIT NONE
    … …  
    14241424    INTEGER k, i
    14251425    REAL zx_qs, rh, tnew, d_rh, rhnew
    1426 
    1427     ! Declaration des constantes et des fonctions thermodynamiques
    1428 
    1429     include "YOMCST.h"
    14301426
    14311427    print *, 'dtime, tau ', dtime, tau
    … …  
    15451541          &, dth_mod_cas, hth_mod_cas, vth_mod_cas, mxcalc)
    15461542
     1543    USE lmdz_yomcst
     1544
    15471545    IMPLICIT NONE
    15481546
    1549     include "YOMCST.h"
    15501547    include "dimensions.h"
    15511548

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

    r5135 r5144  
    11MODULE lmdz_old_1dconv
    2    PRIVATE  ! -- We'd love to put IMPLICIT NONE;  here...
     2  PRIVATE  ! -- We'd love to put IMPLICIT NONE;  here...
    33  PUBLIC get_uvd, copie, get_uvd2, rdgrads, spaces
    44CONTAINS
    … …  
    77          &       ht, hq, hw, hu, hv, hthturb, hqturb, &
    88          &       Ts, imp_fcg, ts_fcg, Tp_fcg, Turb_fcg)
     9
     10    USE lmdz_yomcst
    911
    1012    IMPLICIT NONE
    … …  
    1416    ! pouvoir calculer la convergence et le cisaillement dans la physiq
    1517    !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
    16 
    17     INCLUDE "YOMCST.h"
    1818
    1919    INTEGER klev

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

    r5142 r5144  
    5656    USE lmdz_fcs_gcssold, ONLY: imp_fcg_gcssold, ts_fcg_gcssold, Tp_fcg_gcssold, Tp_ini_gcssold, xTurb_fcg_gcssold
    5757    USE lmdz_tsoilnudge, ONLY: nudge_tsoil, isoil_nudge, Tsoil_nudge, tau_soil_nudge
     58    USE lmdz_yomcst
    5859
    5960    INCLUDE "dimensions.h"
    60     INCLUDE "YOMCST.h"
    6161    INCLUDE "dimsoil.h"
    6262    INCLUDE "compar1d.h"

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

    r5142 r5144  
    4949    USE lmdz_fcs_gcssold, ONLY: imp_fcg_gcssold, ts_fcg_gcssold, Tp_fcg_gcssold, Tp_ini_gcssold, xTurb_fcg_gcssold
    5050    USE lmdz_tsoilnudge, ONLY: nudge_tsoil, isoil_nudge, Tsoil_nudge, tau_soil_nudge
     51    USE lmdz_yomcst
    5152
    5253    INCLUDE "dimensions.h"
    53     INCLUDE "YOMCST.h"
    5454    INCLUDE "dimsoil.h"
    5555    INCLUDE "compar1d.h"

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

    r5135 r5144  
    1 
    21! $Id: mod_1D_cases_read.F90 2373 2015-10-13 17:28:01Z jyg $
    32
    43MODULE mod_1D_cases_read_std
    5   USE netcdf, ONLY:nf90_noerr,nf90_inq_varid,nf90_inq_dimid,nf90_inquire_dimension,nf90_open,nf90_nowrite,&
    6           nf90_strerror,nf90_get_var
    7 
    8 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     4  USE netcdf, ONLY: nf90_noerr, nf90_inq_varid, nf90_inq_dimid, nf90_inquire_dimension, nf90_open, nf90_nowrite, &
     5          nf90_strerror, nf90_get_var
     6
     7  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    98  !Declarations specifiques au cas standard
    109  CHARACTER*80 :: fich_cas
    11   ! Discr?tisation 
     10  ! Discr?tisation
    1211  INTEGER nlev_cas, nt_cas
    1312
    1413
    1514  !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(:,:)
     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(:, :), tke_cas(:, :)
    2322
    2423  !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(:)
     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 :: temp_nudg_cas(:, :), qv_nudg_cas(:, :), u_nudg_cas(:, :), v_nudg_cas(:, :)
     32  REAL, ALLOCATABLE :: invtau_temp_nudg_cas(:, :), invtau_qv_nudg_cas(:, :), invtau_u_nudg_cas(:, :), invtau_v_nudg_cas(:, :)
     33  REAL, ALLOCATABLE :: lat_cas(:), sens_cas(:), tskin_cas(:), ts_cas(:), ps_cas(:), ustar_cas(:)
     34  REAL, ALLOCATABLE :: uw_cas(:, :), vw_cas(:, :), q1_cas(:, :), q2_cas(:, :), tkes_cas(:)
    3635
    3736  !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
    83 
     37  REAL, ALLOCATABLE :: plev_prof_cas(:)
     38  REAL, ALLOCATABLE :: t_prof_cas(:)
     39  REAL, ALLOCATABLE :: theta_prof_cas(:)
     40  REAL, ALLOCATABLE :: thl_prof_cas(:)
     41  REAL, ALLOCATABLE :: thv_prof_cas(:)
     42  REAL, ALLOCATABLE :: q_prof_cas(:)
     43  REAL, ALLOCATABLE :: qv_prof_cas(:)
     44  REAL, ALLOCATABLE :: ql_prof_cas(:)
     45  REAL, ALLOCATABLE :: qi_prof_cas(:)
     46  REAL, ALLOCATABLE :: rh_prof_cas(:)
     47  REAL, ALLOCATABLE :: rv_prof_cas(:)
     48  REAL, ALLOCATABLE :: u_prof_cas(:)
     49  REAL, ALLOCATABLE :: v_prof_cas(:)
     50  REAL, ALLOCATABLE :: vitw_prof_cas(:)
     51  REAL, ALLOCATABLE :: omega_prof_cas(:)
     52  REAL, ALLOCATABLE :: tke_prof_cas(:)
     53  REAL, ALLOCATABLE :: ug_prof_cas(:)
     54  REAL, ALLOCATABLE :: vg_prof_cas(:)
     55  REAL, ALLOCATABLE :: temp_nudg_prof_cas(:), qv_nudg_prof_cas(:), u_nudg_prof_cas(:), v_nudg_prof_cas(:)
     56  REAL, ALLOCATABLE :: invtau_temp_nudg_prof_cas(:), invtau_qv_nudg_prof_cas(:), invtau_u_nudg_prof_cas(:), invtau_v_nudg_prof_cas(:)
     57
     58  REAL, ALLOCATABLE :: ht_prof_cas(:)
     59  REAL, ALLOCATABLE :: hth_prof_cas(:)
     60  REAL, ALLOCATABLE :: hq_prof_cas(:)
     61  REAL, ALLOCATABLE :: vt_prof_cas(:)
     62  REAL, ALLOCATABLE :: vth_prof_cas(:)
     63  REAL, ALLOCATABLE :: vq_prof_cas(:)
     64  REAL, ALLOCATABLE :: dt_prof_cas(:)
     65  REAL, ALLOCATABLE :: dth_prof_cas(:)
     66  REAL, ALLOCATABLE :: dtrad_prof_cas(:)
     67  REAL, ALLOCATABLE :: dq_prof_cas(:)
     68  REAL, ALLOCATABLE :: hu_prof_cas(:)
     69  REAL, ALLOCATABLE :: hv_prof_cas(:)
     70  REAL, ALLOCATABLE :: vu_prof_cas(:)
     71  REAL, ALLOCATABLE :: vv_prof_cas(:)
     72  REAL, ALLOCATABLE :: du_prof_cas(:)
     73  REAL, ALLOCATABLE :: dv_prof_cas(:)
     74  REAL, ALLOCATABLE :: uw_prof_cas(:)
     75  REAL, ALLOCATABLE :: vw_prof_cas(:)
     76  REAL, ALLOCATABLE :: q1_prof_cas(:)
     77  REAL, ALLOCATABLE :: q2_prof_cas(:)
     78
     79  REAL o3_cas, lat_prof_cas, sens_prof_cas, ts_prof_cas, tskin_prof_cas, ps_prof_cas, ustar_prof_cas, tkes_prof_cas
     80  REAL orog_cas, albedo_cas, emiss_cas, q_skin_cas, mom_rough, heat_rough, rugos_cas, sand_cas, clay_cas
    8481
    8582
    … …  
    9390    INCLUDE "date_cas.h"
    9491
    95     INTEGER nid,rid,ierr
    96     INTEGER ii,jj,timeid
     92    INTEGER nid, rid, ierr
     93    INTEGER ii, jj, timeid
    9794    REAL, ALLOCATABLE :: time_val(:)
    9895
    99     fich_cas='cas.nc'
    100     PRINT*,'fich_cas ',fich_cas
    101     ierr = nf90_open(fich_cas,nf90_nowrite,nid)
    102     PRINT*,'fich_cas,nf90_nowrite,nid ',fich_cas,nf90_nowrite,nid
     96    fich_cas = 'cas.nc'
     97    PRINT*, 'fich_cas ', fich_cas
     98    ierr = nf90_open(fich_cas, nf90_nowrite, nid)
     99    PRINT*, 'fich_cas,nf90_nowrite,nid ', fich_cas, nf90_nowrite, nid
    103100    IF (ierr/=nf90_noerr) THEN
    104        WRITE(*,*) 'ERROR: GROS Pb opening forcings nc file '
    105        WRITE(*,*) nf90_strerror(ierr)
    106        stop ""
     101      WRITE(*, *) 'ERROR: GROS Pb opening forcings nc file '
     102      WRITE(*, *) nf90_strerror(ierr)
     103      stop ""
    107104    endif
    108105    !.......................................................................
    109     ierr=nf90_inq_dimid(nid,'lat',rid)
     106    ierr = nf90_inq_dimid(nid, 'lat', rid)
    110107    IF (ierr/=nf90_noerr) THEN
    111        PRINT*, 'Oh probleme lecture dimension lat'
     108      PRINT*, 'Oh probleme lecture dimension lat'
    112109    ENDIF
    113     ierr=nf90_inquire_dimension(nid,rid,len=ii)
    114     PRINT*,'OK1 read_SCM_cas: nid,rid,lat',nid,rid,ii
     110    ierr = nf90_inquire_dimension(nid, rid, len = ii)
     111    PRINT*, 'OK1 read_SCM_cas: nid,rid,lat', nid, rid, ii
    115112    !.......................................................................
    116     ierr=nf90_inq_dimid(nid,'lon',rid)
     113    ierr = nf90_inq_dimid(nid, 'lon', rid)
    117114    IF (ierr/=nf90_noerr) THEN
    118        PRINT*, 'Oh probleme lecture dimension lon'
     115      PRINT*, 'Oh probleme lecture dimension lon'
    119116    ENDIF
    120     ierr=nf90_inquire_dimension(nid,rid,len=jj)
    121     PRINT*,'OK2 read_SCM_cas: nid,rid,lat',nid,rid,jj
     117    ierr = nf90_inquire_dimension(nid, rid, len = jj)
     118    PRINT*, 'OK2 read_SCM_cas: nid,rid,lat', nid, rid, jj
    122119    !.......................................................................
    123     ierr=nf90_inq_dimid(nid,'lev',rid)
     120    ierr = nf90_inq_dimid(nid, 'lev', rid)
    124121    IF (ierr/=nf90_noerr) THEN
    125        PRINT*, 'Oh probleme lecture dimension nlev'
     122      PRINT*, 'Oh probleme lecture dimension nlev'
    126123    ENDIF
    127     ierr=nf90_inquire_dimension(nid,rid,len=nlev_cas)
    128     PRINT*,'OK3 read_SCM_cas: nid,rid,nlev_cas',nid,rid,nlev_cas
    129     IF ( .NOT. ( nlev_cas > 10 .AND. nlev_cas < 200000 )) THEN
    130        PRINT*,'Valeur de nlev_cas peu probable'
    131        STOP
     124    ierr = nf90_inquire_dimension(nid, rid, len = nlev_cas)
     125    PRINT*, 'OK3 read_SCM_cas: nid,rid,nlev_cas', nid, rid, nlev_cas
     126    IF (.NOT. (nlev_cas > 10 .AND. nlev_cas < 200000)) THEN
     127      PRINT*, 'Valeur de nlev_cas peu probable'
     128      STOP
    132129    ENDIF
    133130    !.......................................................................
    134     ierr=nf90_inq_dimid(nid,'time',rid)
    135     nt_cas=0
     131    ierr = nf90_inq_dimid(nid, 'time', rid)
     132    nt_cas = 0
    136133    IF (ierr/=nf90_noerr) THEN
    137        stop 'Oh probleme lecture dimension time'
     134      stop 'Oh probleme lecture dimension time'
    138135    ENDIF
    139     ierr=nf90_inquire_dimension(nid,rid,len=nt_cas)
    140     PRINT*,'OK4 read_SCM_cas: nid,rid,nt_cas',nid,rid,nt_cas
     136    ierr = nf90_inquire_dimension(nid, rid, len = nt_cas)
     137    PRINT*, 'OK4 read_SCM_cas: nid,rid,nt_cas', nid, rid, nt_cas
    141138    ! Lecture de l'axe des temps
    142     PRINT*,'LECTURE DU TEMPS'
    143     ierr=nf90_inq_varid(nid,'time',timeid)
     139    PRINT*, 'LECTURE DU TEMPS'
     140    ierr = nf90_inq_varid(nid, 'time', timeid)
    144141    IF(ierr/=nf90_noerr) THEN
    145        print *,'Variable time manquante dans cas.nc:'
    146        ierr=nf90_noerr
     142      print *, 'Variable time manquante dans cas.nc:'
     143      ierr = nf90_noerr
    147144    else
    148        allocate(time_val(nt_cas))
    149        ierr = nf90_get_var(nid,timeid,time_val)
    150        IF(ierr/=nf90_noerr) THEN
    151           print *,'A Pb a la lecture de time cas.nc: '
    152        endif
     145      allocate(time_val(nt_cas))
     146      ierr = nf90_get_var(nid, timeid, time_val)
     147      IF(ierr/=nf90_noerr) THEN
     148        print *, 'A Pb a la lecture de time cas.nc: '
     149      endif
    153150    endif
    154151    IF (nt_cas>1) THEN
    155        pdt_cas=time_val(2)-time_val(1)
     152      pdt_cas = time_val(2) - time_val(1)
    156153    ELSE
    157        pdt_cas=0.
     154      pdt_cas = 0.
    158155    ENDIF
    159156
    160157
    161 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     158    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    162159    !profils moyens:
    163     allocate(plev_cas(nlev_cas,nt_cas),plevh_cas(nlev_cas+1))       
    164     allocate(z_cas(nlev_cas,nt_cas),zh_cas(nlev_cas+1))
    165     allocate(ap_cas(nlev_cas+1),bp_cas(nlev_cas+1))
    166     allocate(t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas),qv_cas(nlev_cas,nt_cas),ql_cas(nlev_cas,nt_cas), &
    167          qi_cas(nlev_cas,nt_cas),rh_cas(nlev_cas,nt_cas))
    168     allocate(th_cas(nlev_cas,nt_cas),thl_cas(nlev_cas,nt_cas),thv_cas(nlev_cas,nt_cas),rv_cas(nlev_cas,nt_cas))
    169     allocate(u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas),vitw_cas(nlev_cas,nt_cas),omega_cas(nlev_cas,nt_cas))
    170     allocate(tke_cas(nlev_cas,nt_cas))
     160    allocate(plev_cas(nlev_cas, nt_cas), plevh_cas(nlev_cas + 1))
     161    allocate(z_cas(nlev_cas, nt_cas), zh_cas(nlev_cas + 1))
     162    allocate(ap_cas(nlev_cas + 1), bp_cas(nlev_cas + 1))
     163    allocate(t_cas(nlev_cas, nt_cas), q_cas(nlev_cas, nt_cas), qv_cas(nlev_cas, nt_cas), ql_cas(nlev_cas, nt_cas), &
     164            qi_cas(nlev_cas, nt_cas), rh_cas(nlev_cas, nt_cas))
     165    allocate(th_cas(nlev_cas, nt_cas), thl_cas(nlev_cas, nt_cas), thv_cas(nlev_cas, nt_cas), rv_cas(nlev_cas, nt_cas))
     166    allocate(u_cas(nlev_cas, nt_cas), v_cas(nlev_cas, nt_cas), vitw_cas(nlev_cas, nt_cas), omega_cas(nlev_cas, nt_cas))
     167    allocate(tke_cas(nlev_cas, nt_cas))
    171168    !forcing
    172     allocate(ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas),dt_cas(nlev_cas,nt_cas),dtrad_cas(nlev_cas,nt_cas))
    173     allocate(hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas),dq_cas(nlev_cas,nt_cas))
    174     allocate(hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas),dth_cas(nlev_cas,nt_cas))
    175     allocate(hr_cas(nlev_cas,nt_cas),vr_cas(nlev_cas,nt_cas),dr_cas(nlev_cas,nt_cas))
    176     allocate(hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas),du_cas(nlev_cas,nt_cas))
    177     allocate(hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas),dv_cas(nlev_cas,nt_cas))
    178     allocate(ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas))
    179     allocate(temp_nudg_cas(nlev_cas,nt_cas),qv_nudg_cas(nlev_cas,nt_cas))
    180     allocate(u_nudg_cas(nlev_cas,nt_cas),v_nudg_cas(nlev_cas,nt_cas))
    181     allocate(invtau_temp_nudg_cas(nlev_cas,nt_cas),invtau_qv_nudg_cas(nlev_cas,nt_cas))
    182     allocate(invtau_u_nudg_cas(nlev_cas,nt_cas),invtau_v_nudg_cas(nlev_cas,nt_cas))
    183     allocate(lat_cas(nt_cas),sens_cas(nt_cas),ts_cas(nt_cas),tskin_cas(nt_cas),ps_cas(nt_cas),ustar_cas(nt_cas),tkes_cas(nt_cas))
    184     allocate(uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas),q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas))
     169    allocate(ht_cas(nlev_cas, nt_cas), vt_cas(nlev_cas, nt_cas), dt_cas(nlev_cas, nt_cas), dtrad_cas(nlev_cas, nt_cas))
     170    allocate(hq_cas(nlev_cas, nt_cas), vq_cas(nlev_cas, nt_cas), dq_cas(nlev_cas, nt_cas))
     171    allocate(hth_cas(nlev_cas, nt_cas), vth_cas(nlev_cas, nt_cas), dth_cas(nlev_cas, nt_cas))
     172    allocate(hr_cas(nlev_cas, nt_cas), vr_cas(nlev_cas, nt_cas), dr_cas(nlev_cas, nt_cas))
     173    allocate(hu_cas(nlev_cas, nt_cas), vu_cas(nlev_cas, nt_cas), du_cas(nlev_cas, nt_cas))
     174    allocate(hv_cas(nlev_cas, nt_cas), vv_cas(nlev_cas, nt_cas), dv_cas(nlev_cas, nt_cas))
     175    allocate(ug_cas(nlev_cas, nt_cas), vg_cas(nlev_cas, nt_cas))
     176    allocate(temp_nudg_cas(nlev_cas, nt_cas), qv_nudg_cas(nlev_cas, nt_cas))
     177    allocate(u_nudg_cas(nlev_cas, nt_cas), v_nudg_cas(nlev_cas, nt_cas))
     178    allocate(invtau_temp_nudg_cas(nlev_cas, nt_cas), invtau_qv_nudg_cas(nlev_cas, nt_cas))
     179    allocate(invtau_u_nudg_cas(nlev_cas, nt_cas), invtau_v_nudg_cas(nlev_cas, nt_cas))
     180    allocate(lat_cas(nt_cas), sens_cas(nt_cas), ts_cas(nt_cas), tskin_cas(nt_cas), ps_cas(nt_cas), ustar_cas(nt_cas), tkes_cas(nt_cas))
     181    allocate(uw_cas(nlev_cas, nt_cas), vw_cas(nlev_cas, nt_cas), q1_cas(nlev_cas, nt_cas), q2_cas(nlev_cas, nt_cas))
    185182
    186183
    … …  
    205202    allocate(ug_prof_cas(nlev_cas))
    206203    allocate(vg_prof_cas(nlev_cas))
    207     allocate(temp_nudg_prof_cas(nlev_cas),qv_nudg_prof_cas(nlev_cas))
    208     allocate(u_nudg_prof_cas(nlev_cas),v_nudg_prof_cas(nlev_cas))
    209     allocate(invtau_temp_nudg_prof_cas(nlev_cas),invtau_qv_nudg_prof_cas(nlev_cas))
    210     allocate(invtau_u_nudg_prof_cas(nlev_cas),invtau_v_nudg_prof_cas(nlev_cas))
     204    allocate(temp_nudg_prof_cas(nlev_cas), qv_nudg_prof_cas(nlev_cas))
     205    allocate(u_nudg_prof_cas(nlev_cas), v_nudg_prof_cas(nlev_cas))
     206    allocate(invtau_temp_nudg_prof_cas(nlev_cas), invtau_qv_nudg_prof_cas(nlev_cas))
     207    allocate(invtau_u_nudg_prof_cas(nlev_cas), invtau_v_nudg_prof_cas(nlev_cas))
    211208    allocate(ht_prof_cas(nlev_cas))
    212209    allocate(hth_prof_cas(nlev_cas))
    … …  
    230227    allocate(q2_prof_cas(nlev_cas))
    231228
    232     PRINT*,'Allocations OK'
    233     CALL read_SCM (nid,nlev_cas,nt_cas,                                                                    &
    234          ap_cas,bp_cas,z_cas,plev_cas,zh_cas,plevh_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas,                  &
    235          ql_cas,qi_cas,rh_cas,rv_cas,u_cas,v_cas,vitw_cas,omega_cas,tke_cas,ug_cas,vg_cas,                            &
    236          temp_nudg_cas,qv_nudg_cas,u_nudg_cas,v_nudg_cas,                                                    &
    237          invtau_temp_nudg_cas,invtau_qv_nudg_cas,invtau_u_nudg_cas,invtau_v_nudg_cas,                        &
    238          du_cas,hu_cas,vu_cas,                                                                                &
    239          dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,              &
    240          dr_cas,hr_cas,vr_cas,dtrad_cas,sens_cas,lat_cas,ts_cas,tskin_cas,ps_cas,ustar_cas,tkes_cas,            &
    241          uw_cas,vw_cas,q1_cas,q2_cas,orog_cas,albedo_cas,emiss_cas,q_skin_cas,mom_rough,heat_rough, &
    242          o3_cas,rugos_cas,clay_cas,sand_cas)
    243     PRINT*,'read_SCM cas OK'
    244     do ii=1,nlev_cas
    245        PRINT*,'apres read_SCM_cas, plev_cas=',ii,plev_cas(ii,1)
    246        !PRINT*,'apres read_SCM, plev_cas=',ii,omega_cas(ii,nt_cas/2+1)
     229    PRINT*, 'Allocations OK'
     230    CALL read_SCM (nid, nlev_cas, nt_cas, &
     231            ap_cas, bp_cas, z_cas, plev_cas, zh_cas, plevh_cas, t_cas, th_cas, thv_cas, thl_cas, qv_cas, &
     232            ql_cas, qi_cas, rh_cas, rv_cas, u_cas, v_cas, vitw_cas, omega_cas, tke_cas, ug_cas, vg_cas, &
     233            temp_nudg_cas, qv_nudg_cas, u_nudg_cas, v_nudg_cas, &
     234            invtau_temp_nudg_cas, invtau_qv_nudg_cas, invtau_u_nudg_cas, invtau_v_nudg_cas, &
     235            du_cas, hu_cas, vu_cas, &
     236            dv_cas, hv_cas, vv_cas, dt_cas, ht_cas, vt_cas, dq_cas, hq_cas, vq_cas, dth_cas, hth_cas, vth_cas, &
     237            dr_cas, hr_cas, vr_cas, dtrad_cas, sens_cas, lat_cas, ts_cas, tskin_cas, ps_cas, ustar_cas, tkes_cas, &
     238            uw_cas, vw_cas, q1_cas, q2_cas, orog_cas, albedo_cas, emiss_cas, q_skin_cas, mom_rough, heat_rough, &
     239            o3_cas, rugos_cas, clay_cas, sand_cas)
     240    PRINT*, 'read_SCM cas OK'
     241    do ii = 1, nlev_cas
     242      PRINT*, 'apres read_SCM_cas, plev_cas=', ii, plev_cas(ii, 1)
     243      !PRINT*,'apres read_SCM, plev_cas=',ii,omega_cas(ii,nt_cas/2+1)
    247244    enddo
    248245
    249 
    250246  END SUBROUTINE read_SCM_cas
    251247
    252248
    253 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     249  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    254250  SUBROUTINE deallocate2_1D_cases
    255251    !profils environnementaux:
    256     deallocate(plev_cas,plevh_cas)
    257 
    258     deallocate(z_cas,zh_cas)
    259     deallocate(ap_cas,bp_cas)
    260     deallocate(t_cas,q_cas,qv_cas,ql_cas,qi_cas,rh_cas)
    261     deallocate(th_cas,thl_cas,thv_cas,rv_cas)
    262     deallocate(u_cas,v_cas,vitw_cas,omega_cas,tke_cas)
     252    deallocate(plev_cas, plevh_cas)
     253
     254    deallocate(z_cas, zh_cas)
     255    deallocate(ap_cas, bp_cas)
     256    deallocate(t_cas, q_cas, qv_cas, ql_cas, qi_cas, rh_cas)
     257    deallocate(th_cas, thl_cas, thv_cas, rv_cas)
     258    deallocate(u_cas, v_cas, vitw_cas, omega_cas, tke_cas)
    263259
    264260    !forcing
    265     deallocate(ht_cas,vt_cas,dt_cas,dtrad_cas)
    266     deallocate(hq_cas,vq_cas,dq_cas)
    267     deallocate(hth_cas,vth_cas,dth_cas)
    268     deallocate(hr_cas,vr_cas,dr_cas)
    269     deallocate(hu_cas,vu_cas,du_cas)
    270     deallocate(hv_cas,vv_cas,dv_cas)
     261    deallocate(ht_cas, vt_cas, dt_cas, dtrad_cas)
     262    deallocate(hq_cas, vq_cas, dq_cas)
     263    deallocate(hth_cas, vth_cas, dth_cas)
     264    deallocate(hr_cas, vr_cas, dr_cas)
     265    deallocate(hu_cas, vu_cas, du_cas)
     266    deallocate(hv_cas, vv_cas, dv_cas)
    271267    deallocate(ug_cas)
    272268    deallocate(vg_cas)
    273     deallocate(lat_cas,sens_cas,tskin_cas,ts_cas,ps_cas,ustar_cas,tkes_cas,uw_cas,vw_cas,q1_cas,q2_cas)
     269    deallocate(lat_cas, sens_cas, tskin_cas, ts_cas, ps_cas, ustar_cas, tkes_cas, uw_cas, vw_cas, q1_cas, q2_cas)
    274270
    275271    !champs interpoles
    … …  
    292288    deallocate(ug_prof_cas)
    293289    deallocate(vg_prof_cas)
    294     deallocate(temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas)
    295     deallocate(invtau_temp_nudg_prof_cas,invtau_qv_nudg_prof_cas,invtau_u_nudg_prof_cas,invtau_v_nudg_prof_cas)
     290    deallocate(temp_nudg_prof_cas, qv_nudg_prof_cas, u_nudg_prof_cas, v_nudg_prof_cas)
     291    deallocate(invtau_temp_nudg_prof_cas, invtau_qv_nudg_prof_cas, invtau_u_nudg_prof_cas, invtau_v_nudg_prof_cas)
    296292    deallocate(ht_prof_cas)
    297293    deallocate(hq_prof_cas)
    … …  
    319315
    320316  !=====================================================================
    321   SUBROUTINE read_SCM(nid,nlevel,ntime,                                      &
    322        ap,bp,zz,pp,zzh,pph,temp,theta,thv,thl,qv,ql,qi,rh,rv,u,v,vitw,omega,tke,ug,vg,&
    323        temp_nudg,qv_nudg,u_nudg,v_nudg,                                        &
    324        invtau_temp_nudg,invtau_qv_nudg,invtau_u_nudg,invtau_v_nudg,            &
    325        du,hu,vu,dv,hv,vv,dt,ht,vt,dq,hq,vq,                                    &
    326        dth,hth,vth,dr,hr,vr,dtrad,sens,flat,ts,tskin,ps,ustar,tkes,uw,vw,q1,q2,      &
    327        orog_cas,albedo_cas,emiss_cas,q_skin_cas,mom_rough,          &
    328        heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas)
     317  SUBROUTINE read_SCM(nid, nlevel, ntime, &
     318          ap, bp, zz, pp, zzh, pph, temp, theta, thv, thl, qv, ql, qi, rh, rv, u, v, vitw, omega, tke, ug, vg, &
     319          temp_nudg, qv_nudg, u_nudg, v_nudg, &
     320          invtau_temp_nudg, invtau_qv_nudg, invtau_u_nudg, invtau_v_nudg, &
     321          du, hu, vu, dv, hv, vv, dt, ht, vt, dq, hq, vq, &
     322          dth, hth, vth, dr, hr, vr, dtrad, sens, flat, ts, tskin, ps, ustar, tkes, uw, vw, q1, q2, &
     323          orog_cas, albedo_cas, emiss_cas, q_skin_cas, mom_rough, &
     324          heat_rough, o3_cas, rugos_cas, clay_cas, sand_cas)
    329325
    330326    !program reading forcing of the case study
    … …  
    332328    INCLUDE "compar1d.h"
    333329
    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)
     330    INTEGER ntime, nlevel, k, t
     331
     332    REAL ap(nlevel + 1), bp(nlevel + 1)
     333    REAL zz(nlevel, ntime), zzh(nlevel + 1)
     334    REAL pp(nlevel, ntime), pph(nlevel + 1)
    339335    !profils initiaux
    340     REAL temp0(nlevel),qv0(nlevel),ql0(nlevel),qi0(nlevel),u0(nlevel),v0(nlevel),tke0(nlevel)
     336    REAL temp0(nlevel), qv0(nlevel), ql0(nlevel), qi0(nlevel), u0(nlevel), v0(nlevel), tke0(nlevel)
    341337    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
     338    REAL temp(nlevel, ntime), qv(nlevel, ntime), ql(nlevel, ntime), qi(nlevel, ntime), rh(nlevel, ntime)
     339    REAL theta(nlevel, ntime), thv(nlevel, ntime), thl(nlevel, ntime), rv(nlevel, ntime)
     340    REAL u(nlevel, ntime), v(nlevel, ntime), tkes(ntime)
     341    REAL temp_nudg(nlevel, ntime), qv_nudg(nlevel, ntime), u_nudg(nlevel, ntime), v_nudg(nlevel, ntime)
     342    REAL invtau_temp_nudg(nlevel, ntime), invtau_qv_nudg(nlevel, ntime), invtau_u_nudg(nlevel, ntime), invtau_v_nudg(nlevel, ntime)
     343    REAL ug(nlevel, ntime), vg(nlevel, ntime)
     344    REAL vitw(nlevel, ntime), omega(nlevel, ntime), tke(nlevel, ntime)
     345    REAL du(nlevel, ntime), hu(nlevel, ntime), vu(nlevel, ntime)
     346    REAL dv(nlevel, ntime), hv(nlevel, ntime), vv(nlevel, ntime)
     347    REAL dt(nlevel, ntime), ht(nlevel, ntime), vt(nlevel, ntime)
     348    REAL dtrad(nlevel, ntime)
     349    REAL dq(nlevel, ntime), hq(nlevel, ntime), vq(nlevel, ntime)
     350    REAL dth(nlevel, ntime), hth(nlevel, ntime), vth(nlevel, ntime), hthl(nlevel, ntime)
     351    REAL dr(nlevel, ntime), hr(nlevel, ntime), vr(nlevel, ntime)
     352    REAL flat(ntime), sens(ntime), ustar(ntime)
     353    REAL uw(nlevel, ntime), vw(nlevel, ntime), q1(nlevel, ntime), q2(nlevel, ntime)
     354    REAL ts(ntime), tskin(ntime), ps(ntime)
     355    REAL orog_cas, albedo_cas, emiss_cas, q_skin_cas, mom_rough, heat_rough, o3_cas, rugos_cas, clay_cas, sand_cas
     356    REAL apbp(nlevel + 1), resul(nlevel, ntime), resul1(nlevel), resul2(ntime), resul3
     357
     358    INTEGER nid, ierr, ierr1, ierr2, rid, i, int_test
    364359    INTEGER nbvar3d
    365     parameter(nbvar3d=78)
    366     INTEGER var3didin(nbvar3d),missing_var(nbvar3d)
     360    parameter(nbvar3d = 78)
     361    INTEGER var3didin(nbvar3d), missing_var(nbvar3d)
    367362    CHARACTER*13 name_var(1:nbvar3d)
    368363
    … …  
    385380    !     &'o3','rugos','clay','sand'/
    386381
    387 
    388 
    389382    data name_var/ &
    390                                 ! coordonnees pression (n+1 niveaux) #4
    391          'coor_par_a','coor_par_b','zf','pressure_h',& ! #1-#4
    392                                 ! coordonnees pression (n niveaux) #8
    393          'ta','qv','ql','qi','ua','va','tke','pa',& ! #5-#12
    394                                 ! coordonnees pression + temps #46
    395          'wa','wap','ug','vg','tnua_adv','tnua_advh','tnua_advv','tnva_adv','tnva_advh','tnva_advv','tnta_adv','tnta_advh',& !  #13 - #25
    396          'tnta_advv','tnqv_adv','tnqv_advh','tnqv_advv','thadv','thadvh','thadvv','thladvh',                            & ! #26 - #32
    397          'radv','radvh','radvv','tnta_rad','q1','q2','ustress','vstress',                          & ! #33 - #40
    398          'rh','ta_nud','qv_nud','ua_nud','va_nud',                                      & ! #41-45
    399          'zh_forc','pa_forc','tat','thetat','thetavt','thetalt','qvt','qlt','qit','rvt','uat','vat',  & ! #46-57
    400          'nudging_constant_ta', 'nudging_constant_qv', 'nudging_constant_ua', 'nudging_constant_va',          & ! # 58-61
    401                                 ! coordonnees temps #12
    402          'tkes','hfss','hfls','ts_forc','tskin','ps_forc','ustar', &                     ! 62-68
    403                                   ! scalaires
    404          'orog','albedo','emiss','q_skin','z0','z0h',      &                    ! 69-74
    405          'O3','rugos','clay','sand'/                                                      ! 75-78
     383            ! coordonnees pression (n+1 niveaux) #4
     384            'coor_par_a', 'coor_par_b', 'zf', 'pressure_h', & ! #1-#4
     385            ! coordonnees pression (n niveaux) #8
     386            'ta', 'qv', 'ql', 'qi', 'ua', 'va', 'tke', 'pa', & ! #5-#12
     387            ! coordonnees pression + temps #46
     388            'wa', 'wap', 'ug', 'vg', 'tnua_adv', 'tnua_advh', 'tnua_advv', 'tnva_adv', 'tnva_advh', 'tnva_advv', 'tnta_adv', 'tnta_advh', & !  #13 - #25
     389            'tnta_advv', 'tnqv_adv', 'tnqv_advh', 'tnqv_advv', 'thadv', 'thadvh', 'thadvv', 'thladvh', & ! #26 - #32
     390            'radv', 'radvh', 'radvv', 'tnta_rad', 'q1', 'q2', 'ustress', 'vstress', & ! #33 - #40
     391            'rh', 'ta_nud', 'qv_nud', 'ua_nud', 'va_nud', & ! #41-45
     392            'zh_forc', 'pa_forc', 'tat', 'thetat', 'thetavt', 'thetalt', 'qvt', 'qlt', 'qit', 'rvt', 'uat', 'vat', & ! #46-57
     393            'nudging_constant_ta', 'nudging_constant_qv', 'nudging_constant_ua', 'nudging_constant_va', & ! # 58-61
     394            ! coordonnees temps #12
     395            'tkes', 'hfss', 'hfls', 'ts_forc', 'tskin', 'ps_forc', 'ustar', &                     ! 62-68
     396            ! scalaires
     397            'orog', 'albedo', 'emiss', 'q_skin', 'z0', 'z0h', &                    ! 69-74
     398            'O3', 'rugos', 'clay', 'sand'/                                                      ! 75-78
    406399
    407400
    … …  
    411404    !-----------------------------------------------------------------------
    412405
    413 
    414     ierr=nf90_inq_varid(nid,'ta',int_test)
     406    ierr = nf90_inq_varid(nid, 'ta', int_test)
    415407    IF(ierr/=nf90_noerr) THEN
    416        PRINT*, '++++++++++++++++++++++++++++++'
    417        PRINT*, 'variable ta missing in cas.nc '
    418        PRINT*, 'You are probably using an obsolete version of the 1D cases'
    419        PRINT*, 'please dowload the last version of the 1D archive from https://lmdz.lmd.jussieu.fr/pub/'
    420        PRINT*, '++++++++++++++++++++++++++++++'
    421        CALL abort_gcm ('mod_1D_cases_read_std','bad version of 1D directory',0)
     408      PRINT*, '++++++++++++++++++++++++++++++'
     409      PRINT*, 'variable ta missing in cas.nc '
     410      PRINT*, 'You are probably using an obsolete version of the 1D cases'
     411      PRINT*, 'please dowload the last version of the 1D archive from https://lmdz.lmd.jussieu.fr/pub/'
     412      PRINT*, '++++++++++++++++++++++++++++++'
     413      CALL abort_gcm ('mod_1D_cases_read_std', 'bad version of 1D directory', 0)
    422414    endif
    423415
    … …  
    427419    !-----------------------------------------------------------------------
    428420
    429     do i=1,nbvar3d
    430        missing_var(i)=0.
    431        ierr=nf90_inq_varid(nid,name_var(i),var3didin(i))
    432        PRINT*, 'name_var(i)', name_var(i), var3didin(i)
    433        IF(ierr/=nf90_noerr) THEN
    434           print *,'Variable manquante dans cas.nc:',i,name_var(i)
    435           ierr=nf90_noerr
    436           missing_var(i)=1
    437        else
     421    do i = 1, nbvar3d
     422      missing_var(i) = 0.
     423      ierr = nf90_inq_varid(nid, name_var(i), var3didin(i))
     424      PRINT*, 'name_var(i)', name_var(i), var3didin(i)
     425      IF(ierr/=nf90_noerr) THEN
     426        print *, 'Variable manquante dans cas.nc:', i, name_var(i)
     427        ierr = nf90_noerr
     428        missing_var(i) = 1
     429      else
     430
     431        !-----------------------------------------------------------------------
     432        ! Activating keys depending on the presence of specific variables in cas.nc
     433        !-----------------------------------------------------------------------
     434        IF (1 == 1) THEN
     435          ! A MODIFIER: il faudrait dire nudging_temp mais faut le declarer dans compar1d.h etc...
     436          !           if ( name_var(i) == 'temp_nudging' .AND. nint(nudging_t)==0) stop 'Nudging inconsistency temp'
     437          IF (name_var(i) == 'qv_nud' .AND. nint(nudging_qv)==0) stop 'Nudging inconsistency qv'
     438          IF (name_var(i) == 'ua_nud' .AND. nint(nudging_u)==0) stop 'Nudging inconsistency u'
     439          IF (name_var(i) == 'va_nud' .AND. nint(nudging_v)==0) stop 'Nudging inconsistency v'
     440        ELSE
     441          PRINT*, 'GUIDAGE : CONSISTENCY CHECK DEACTIVATED FOR TESTS of SANDU/REF'
     442        ENDIF
     443
     444        !-----------------------------------------------------------------------
     445        ! Reading variables 1D (N+1) vertical variables (nlevelp1,lat,lon)
     446        !-----------------------------------------------------------------------
     447        IF(i<=4) THEN
     448          ierr = nf90_get_var(nid, var3didin(i), apbp)
     449          print *, 'read_SCM(apbp), on a lu ', i, name_var(i)
     450          IF(ierr/=nf90_noerr) THEN
     451            print *, 'B Pb a la lecture de cas.nc: ', name_var(i)
     452            stop "getvarup"
     453          endif
    438454
    439455          !-----------------------------------------------------------------------
    440           ! Activating keys depending on the presence of specific variables in cas.nc
     456          !  Reading 1D (N) vertical varialbes    (nlevel,lat,lon)
    441457          !-----------------------------------------------------------------------
    442           IF ( 1 == 1 ) THEN
    443              ! 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'
    448           ELSE
    449              PRINT*,'GUIDAGE : CONSISTENCY CHECK DEACTIVATED FOR TESTS of SANDU/REF'
    450           ENDIF
     458        else IF(i>4.AND.i<=12) THEN
     459          ierr = nf90_get_var(nid, var3didin(i), resul1)
     460          print *, 'read_SCM(resul1), on a lu ', i, name_var(i)
     461          IF(ierr/=nf90_noerr) THEN
     462            print *, 'C Pb a la lecture de cas.nc: ', name_var(i)
     463            stop "getvarup"
     464          endif
     465          PRINT*, 'Lecture de la variable #i ', i, name_var(i), minval(resul1), maxval(resul1)
    451466
    452467          !-----------------------------------------------------------------------
    453           ! Reading variables 1D (N+1) vertical variables (nlevelp1,lat,lon)
     468          !  Reading 2D tim-vertical variables  (time,nlevel,lat,lon)
     469          !  TBD : seems to be the same as above.
    454470          !-----------------------------------------------------------------------
    455           IF(i<=4) THEN
    456              ierr = nf90_get_var(nid,var3didin(i),apbp)
    457              print *,'read_SCM(apbp), on a lu ',i,name_var(i)
    458              IF(ierr/=nf90_noerr) THEN
    459                 print *,'B Pb a la lecture de cas.nc: ',name_var(i)
    460                 stop "getvarup"
    461              endif
    462 
    463              !-----------------------------------------------------------------------
    464              !  Reading 1D (N) vertical varialbes    (nlevel,lat,lon)   
    465              !-----------------------------------------------------------------------
    466           else IF(i>4.AND.i<=12) THEN
    467              ierr = nf90_get_var(nid,var3didin(i),resul1)
    468              print *,'read_SCM(resul1), on a lu ',i,name_var(i)
    469              IF(ierr/=nf90_noerr) THEN
    470                 print *,'C Pb a la lecture de cas.nc: ',name_var(i)
    471                 stop "getvarup"
    472              endif
    473              PRINT*,'Lecture de la variable #i ',i,name_var(i),minval(resul1),maxval(resul1)
    474 
    475              !-----------------------------------------------------------------------
    476              !  Reading 2D tim-vertical variables  (time,nlevel,lat,lon)
    477              !  TBD : seems to be the same as above.
    478              !-----------------------------------------------------------------------
    479           else IF(i>12.AND.i<=61) THEN
    480              ierr = nf90_get_var(nid,var3didin(i),resul)
    481              print *,'read_SCM(resul), on a lu ',i,name_var(i)
    482              IF(ierr/=nf90_noerr) THEN
    483                 print *,'D Pb a la lecture de cas.nc: ',name_var(i)
    484                 stop "getvarup"
    485              endif
    486              PRINT*,'Lecture de la variable #i ',i,name_var(i),minval(resul),maxval(resul)
    487 
    488              !-----------------------------------------------------------------------
    489              !  Reading 1D time variables (time,lat,lon)
    490              !-----------------------------------------------------------------------
    491           ELSE IF (i>62.AND.i<=75) THEN
    492              ierr = nf90_get_var(nid,var3didin(i),resul2)
    493              print *,'read_SCM(resul2), on a lu ',i,name_var(i)
    494              IF(ierr/=nf90_noerr) THEN
    495                 print *,'E Pb a la lecture de cas.nc: ',name_var(i)
    496                 stop "getvarup"
    497              endif
    498              PRINT*,'Lecture de la variable #i  ',i,name_var(i),minval(resul2),maxval(resul2)
    499 
    500              !-----------------------------------------------------------------------
    501              ! Reading scalar variables (lat,lon)
    502              !-----------------------------------------------------------------------
    503           else
    504              ierr = nf90_get_var(nid,var3didin(i),resul3)
    505              print *,'read_SCM(resul3), on a lu ',i,name_var(i)
    506              IF(ierr/=nf90_noerr) THEN
    507                 print *,'F Pb a la lecture de cas.nc: ',name_var(i)
    508                 stop "getvarup"
    509              endif
    510              PRINT*,'Lecture de la variable #i ',i,name_var(i),resul3
     471        else IF(i>12.AND.i<=61) THEN
     472          ierr = nf90_get_var(nid, var3didin(i), resul)
     473          print *, 'read_SCM(resul), on a lu ', i, name_var(i)
     474          IF(ierr/=nf90_noerr) THEN
     475            print *, 'D Pb a la lecture de cas.nc: ', name_var(i)
     476            stop "getvarup"
    511477          endif
    512        endif
    513 
    514        !-----------------------------------------------------------------------
    515        ! Attributing variables
    516        !-----------------------------------------------------------------------
    517        select case(i)
    518           !case(1) ; ap=apbp       ! donnees indexees en nlevel+1
    519           ! case(2) ; bp=apbp
    520        case(3) ; zzh=apbp
    521        case(4) ; pph=apbp
    522        case(5) ; temp0=resul1    ! donnees initiales
    523        case(6) ; qv0=resul1
    524        case(7) ; ql0=resul1
    525        case(8) ; qi0=resul1
    526        case(9) ; u0=resul1
    527        case(10) ; v0=resul1
    528        case(11) ; tke0=resul1
    529        case(12) ; pp0=resul1
    530        case(13) ; vitw=resul    ! donnees indexees en nlevel,time
    531        case(14) ; omega=resul
    532        case(15) ; ug=resul
    533        case(16) ; vg=resul
    534        case(17) ; du=resul
    535        case(18) ; hu=resul
    536        case(19) ; vu=resul
    537        case(20) ; dv=resul
    538        case(21) ; hv=resul
    539        case(22) ; vv=resul
    540        case(23) ; dt=resul
    541        case(24) ; ht=resul
    542        case(25) ; vt=resul
    543        case(26) ; dq=resul
    544        case(27) ; hq=resul
    545        case(28) ; vq=resul
    546        case(29) ; dth=resul
    547        case(30) ; hth=resul
    548        case(31) ; vth=resul
    549        case(32) ; hthl=resul
    550        case(33) ; dr=resul
    551        case(34) ; hr=resul
    552        case(35) ; vr=resul
    553        case(36) ; dtrad=resul
    554        case(37) ; q1=resul
    555        case(38) ; q2=resul
    556        case(39) ; uw=resul
    557        case(40) ; vw=resul
    558        case(41) ; rh=resul
    559        case(42) ; temp_nudg=resul
    560        case(43) ; qv_nudg=resul
    561        case(44) ; u_nudg=resul
    562        case(45) ; v_nudg=resul
    563        case(46) ; zz=resul      ! donnees en time,nlevel pour profil initial
    564        case(47) ; pp=resul
    565        case(48) ; temp=resul
    566        case(49) ; theta=resul
    567        case(50) ; thv=resul
    568        case(51) ; thl=resul
    569        case(52) ; qv=resul
    570        case(53) ; ql=resul
    571        case(54) ; qi=resul
    572        case(55) ; rv=resul
    573        case(56) ; u=resul
    574        case(57) ; v=resul
    575        case(58) ; invtau_temp_nudg=resul
    576        case(59) ; invtau_qv_nudg=resul
    577        case(60) ; invtau_u_nudg=resul
    578        case(61) ; invtau_v_nudg=resul
    579        case(62) ; tkes=resul2   ! donnees indexees en time
    580        case(63) ; sens=resul2
    581        case(64) ; flat=resul2
    582        case(65) ; ts=resul2
    583        case(66) ; tskin=resul2       
    584        case(67) ; ps=resul2
    585        case(68) ; ustar=resul2
    586        case(69) ; orog_cas=resul3      ! constantes
    587        case(70) ; albedo_cas=resul3
    588        case(71) ; emiss_cas=resul3
    589        case(72) ; q_skin_cas=resul3
    590        case(73) ; mom_rough=resul3
    591        case(74) ; heat_rough=resul3
    592        case(75) ; o3_cas=resul3       
    593        case(76) ; rugos_cas=resul3
    594        case(77) ; clay_cas=resul3
    595        case(78) ; sand_cas=resul3
    596        end select
    597        resul=0.
    598        resul1=0.
    599        resul2=0.
    600        resul3=0.
     478          PRINT*, 'Lecture de la variable #i ', i, name_var(i), minval(resul), maxval(resul)
     479
     480          !-----------------------------------------------------------------------
     481          !  Reading 1D time variables (time,lat,lon)
     482          !-----------------------------------------------------------------------
     483        ELSE IF (i>62.AND.i<=75) THEN
     484          ierr = nf90_get_var(nid, var3didin(i), resul2)
     485          print *, 'read_SCM(resul2), on a lu ', i, name_var(i)
     486          IF(ierr/=nf90_noerr) THEN
     487            print *, 'E Pb a la lecture de cas.nc: ', name_var(i)
     488            stop "getvarup"
     489          endif
     490          PRINT*, 'Lecture de la variable #i  ', i, name_var(i), minval(resul2), maxval(resul2)
     491
     492          !-----------------------------------------------------------------------
     493          ! Reading scalar variables (lat,lon)
     494          !-----------------------------------------------------------------------
     495        else
     496          ierr = nf90_get_var(nid, var3didin(i), resul3)
     497          print *, 'read_SCM(resul3), on a lu ', i, name_var(i)
     498          IF(ierr/=nf90_noerr) THEN
     499            print *, 'F Pb a la lecture de cas.nc: ', name_var(i)
     500            stop "getvarup"
     501          endif
     502          PRINT*, 'Lecture de la variable #i ', i, name_var(i), resul3
     503        endif
     504      endif
     505
     506      !-----------------------------------------------------------------------
     507      ! Attributing variables
     508      !-----------------------------------------------------------------------
     509      select case(i)
     510        !case(1) ; ap=apbp       ! donnees indexees en nlevel+1
     511        ! case(2) ; bp=apbp
     512      case(3) ; zzh = apbp
     513      case(4) ; pph = apbp
     514      case(5) ; temp0 = resul1    ! donnees initiales
     515      case(6) ; qv0 = resul1
     516      case(7) ; ql0 = resul1
     517      case(8) ; qi0 = resul1
     518      case(9) ; u0 = resul1
     519      case(10) ; v0 = resul1
     520      case(11) ; tke0 = resul1
     521      case(12) ; pp0 = resul1
     522      case(13) ; vitw = resul    ! donnees indexees en nlevel,time
     523      case(14) ; omega = resul
     524      case(15) ; ug = resul
     525      case(16) ; vg = resul
     526      case(17) ; du = resul
     527      case(18) ; hu = resul
     528      case(19) ; vu = resul
     529      case(20) ; dv = resul
     530      case(21) ; hv = resul
     531      case(22) ; vv = resul
     532      case(23) ; dt = resul
     533      case(24) ; ht = resul
     534      case(25) ; vt = resul
     535      case(26) ; dq = resul
     536      case(27) ; hq = resul
     537      case(28) ; vq = resul
     538      case(29) ; dth = resul
     539      case(30) ; hth = resul
     540      case(31) ; vth = resul
     541      case(32) ; hthl = resul
     542      case(33) ; dr = resul
     543      case(34) ; hr = resul
     544      case(35) ; vr = resul
     545      case(36) ; dtrad = resul
     546      case(37) ; q1 = resul
     547      case(38) ; q2 = resul
     548      case(39) ; uw = resul
     549      case(40) ; vw = resul
     550      case(41) ; rh = resul
     551      case(42) ; temp_nudg = resul
     552      case(43) ; qv_nudg = resul
     553      case(44) ; u_nudg = resul
     554      case(45) ; v_nudg = resul
     555      case(46) ; zz = resul      ! donnees en time,nlevel pour profil initial
     556      case(47) ; pp = resul
     557      case(48) ; temp = resul
     558      case(49) ; theta = resul
     559      case(50) ; thv = resul
     560      case(51) ; thl = resul
     561      case(52) ; qv = resul
     562      case(53) ; ql = resul
     563      case(54) ; qi = resul
     564      case(55) ; rv = resul
     565      case(56) ; u = resul
     566      case(57) ; v = resul
     567      case(58) ; invtau_temp_nudg = resul
     568      case(59) ; invtau_qv_nudg = resul
     569      case(60) ; invtau_u_nudg = resul
     570      case(61) ; invtau_v_nudg = resul
     571      case(62) ; tkes = resul2   ! donnees indexees en time
     572      case(63) ; sens = resul2
     573      case(64) ; flat = resul2
     574      case(65) ; ts = resul2
     575      case(66) ; tskin = resul2
     576      case(67) ; ps = resul2
     577      case(68) ; ustar = resul2
     578      case(69) ; orog_cas = resul3      ! constantes
     579      case(70) ; albedo_cas = resul3
     580      case(71) ; emiss_cas = resul3
     581      case(72) ; q_skin_cas = resul3
     582      case(73) ; mom_rough = resul3
     583      case(74) ; heat_rough = resul3
     584      case(75) ; o3_cas = resul3
     585      case(76) ; rugos_cas = resul3
     586      case(77) ; clay_cas = resul3
     587      case(78) ; sand_cas = resul3
     588      end select
     589      resul = 0.
     590      resul1 = 0.
     591      resul2 = 0.
     592      resul3 = 0.
    601593    enddo
    602     PRINT*,'Lecture de la variable APRES ,sens ',minval(sens),maxval(sens)
    603     PRINT*,'Lecture de la variable APRES ,flat ',minval(flat),maxval(flat)
     594    PRINT*, 'Lecture de la variable APRES ,sens ', minval(sens), maxval(sens)
     595    PRINT*, 'Lecture de la variable APRES ,flat ', minval(flat), maxval(flat)
    604596
    605597    !CR:ATTENTION EN ATTENTE DE REGLER LA QUESTION DU PAS DE TEMPS INITIAL
    606     do t=1,ntime
    607        do k=1,nlevel
    608           temp(k,t)=temp0(k)
    609           qv(k,t)=qv0(k)
    610           ql(k,t)=ql0(k)
    611           qi(k,t)=qi0(k)
    612           u(k,t)=u0(k)
    613           v(k,t)=v0(k)
    614           tke(k,t)=tke0(k)
    615        enddo
     598    do t = 1, ntime
     599      do k = 1, nlevel
     600        temp(k, t) = temp0(k)
     601        qv(k, t) = qv0(k)
     602        ql(k, t) = ql0(k)
     603        qi(k, t) = qi0(k)
     604        u(k, t) = u0(k)
     605        v(k, t) = v0(k)
     606        tke(k, t) = tke0(k)
     607      enddo
    616608    enddo
    617 !!!! TRAVAIL : EN FONCTION DES DECISIONS SUR LA SPECIFICATION DE W
    618 !!!omega=-vitw*pres*rg/(rd*temp)
     609    !!!! TRAVAIL : EN FONCTION DES DECISIONS SUR LA SPECIFICATION DE W
     610    !!!omega=-vitw*pres*rg/(rd*temp)
    619611    !-----------------------------------------------------------------------
    620 
    621612
    622613  END SUBROUTINE read_SCM
    … …  
    628619
    629620  !**********************************************************************************************
    630   SUBROUTINE interp_case_time_std(day,day1,annee_ref                           &
    631        !    &         ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas                         &
    632        ,nt_cas,nlev_cas                                                   &
    633        ,ts_cas,tskin_cas,ps_cas,plev_cas,t_cas,theta_cas,thv_cas,thl_cas            &
    634        ,qv_cas,ql_cas,qi_cas,u_cas,v_cas                                  &
    635        ,ug_cas,vg_cas,temp_nudg_cas,qv_nudg_cas,u_nudg_cas,v_nudg_cas     &
    636        ,invtau_temp_nudg_cas,invtau_qv_nudg_cas,invtau_u_nudg_cas,invtau_v_nudg_cas     &
    637        ,vitw_cas,omega_cas,tke_cas,du_cas,hu_cas,vu_cas             &
    638        ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas               &
    639        ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas                      &
    640        ,lat_cas,sens_cas,ustar_cas                                        &
    641        ,uw_cas,vw_cas,q1_cas,q2_cas,tkes_cas                               &
    642 
    643        ,ts_prof_cas,tskin_prof_cas,ps_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas               &
    644        ,thv_prof_cas,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas     &
    645        ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas                     &
    646        ,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas     &
    647        ,invtau_temp_nudg_prof_cas,invtau_qv_nudg_prof_cas,invtau_u_nudg_prof_cas,invtau_v_nudg_prof_cas     &     
    648        ,vitw_prof_cas,omega_prof_cas,tke_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas  &
    649        ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas                   &
    650        ,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas                &
    651        ,hq_prof_cas,vq_prof_cas,dth_prof_cas,hth_prof_cas,vth_prof_cas    &
    652        ,lat_prof_cas,sens_prof_cas                                        &
    653        ,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tkes_prof_cas)
    654 
    655 
    656 
    657 
    658 
     621  SUBROUTINE interp_case_time_std(day, day1, annee_ref                           &
     622          !    &         ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas                         &
     623          , nt_cas, nlev_cas                                                   &
     624          , ts_cas, tskin_cas, ps_cas, plev_cas, t_cas, theta_cas, thv_cas, thl_cas            &
     625          , qv_cas, ql_cas, qi_cas, u_cas, v_cas                                  &
     626          , ug_cas, vg_cas, temp_nudg_cas, qv_nudg_cas, u_nudg_cas, v_nudg_cas     &
     627          , invtau_temp_nudg_cas, invtau_qv_nudg_cas, invtau_u_nudg_cas, invtau_v_nudg_cas     &
     628          , vitw_cas, omega_cas, tke_cas, du_cas, hu_cas, vu_cas             &
     629          , dv_cas, hv_cas, vv_cas, dt_cas, ht_cas, vt_cas, dtrad_cas               &
     630          , dq_cas, hq_cas, vq_cas, dth_cas, hth_cas, vth_cas                      &
     631          , lat_cas, sens_cas, ustar_cas                                        &
     632          , uw_cas, vw_cas, q1_cas, q2_cas, tkes_cas                               &
     633
     634          , ts_prof_cas, tskin_prof_cas, ps_prof_cas, plev_prof_cas, t_prof_cas, theta_prof_cas               &
     635          , thv_prof_cas, thl_prof_cas, qv_prof_cas, ql_prof_cas, qi_prof_cas     &
     636          , u_prof_cas, v_prof_cas, ug_prof_cas, vg_prof_cas                     &
     637          , temp_nudg_prof_cas, qv_nudg_prof_cas, u_nudg_prof_cas, v_nudg_prof_cas     &
     638          , invtau_temp_nudg_prof_cas, invtau_qv_nudg_prof_cas, invtau_u_nudg_prof_cas, invtau_v_nudg_prof_cas     &
     639          , vitw_prof_cas, omega_prof_cas, tke_prof_cas, du_prof_cas, hu_prof_cas, vu_prof_cas  &
     640          , dv_prof_cas, hv_prof_cas, vv_prof_cas, dt_prof_cas                   &
     641          , ht_prof_cas, vt_prof_cas, dtrad_prof_cas, dq_prof_cas                &
     642          , hq_prof_cas, vq_prof_cas, dth_prof_cas, hth_prof_cas, vth_prof_cas    &
     643          , lat_prof_cas, sens_prof_cas                                        &
     644          , ustar_prof_cas, uw_prof_cas, vw_prof_cas, q1_prof_cas, q2_prof_cas, tkes_prof_cas)
    659645
    660646    IMPLICIT NONE
    … …  
    665651    ! day: current julian day (e.g. 717538.2)
    666652    ! day1: first day of the simulation
    667     ! nt_cas: total nb of data in the forcing 
     653    ! nt_cas: total nb of data in the forcing
    668654    ! pdt_cas: total time interval (in sec) between 2 forcing data
    669655    !---------------------------------------------------------------------------------------
    … …  
    674660    ! inputs:
    675661    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)
     662    INTEGER nt_cas, nlev_cas
     663    REAL day, day1, day_cas
     664    REAL ts_cas(nt_cas), tskin_cas(nt_cas), ps_cas(nt_cas)
     665    REAL plev_cas(nlev_cas, nt_cas)
     666    REAL t_cas(nlev_cas, nt_cas), theta_cas(nlev_cas, nt_cas)
     667    REAL thv_cas(nlev_cas, nt_cas), thl_cas(nlev_cas, nt_cas)
     668    REAL qv_cas(nlev_cas, nt_cas), ql_cas(nlev_cas, nt_cas), qi_cas(nlev_cas, nt_cas)
     669    REAL u_cas(nlev_cas, nt_cas), v_cas(nlev_cas, nt_cas)
     670    REAL ug_cas(nlev_cas, nt_cas), vg_cas(nlev_cas, nt_cas)
     671    REAL temp_nudg_cas(nlev_cas, nt_cas), qv_nudg_cas(nlev_cas, nt_cas)
     672    REAL u_nudg_cas(nlev_cas, nt_cas), v_nudg_cas(nlev_cas, nt_cas)
     673
     674    REAL invtau_temp_nudg_cas(nlev_cas, nt_cas), invtau_qv_nudg_cas(nlev_cas, nt_cas)
     675    REAL invtau_u_nudg_cas(nlev_cas, nt_cas), invtau_v_nudg_cas(nlev_cas, nt_cas)
     676
     677    REAL vitw_cas(nlev_cas, nt_cas), omega_cas(nlev_cas, nt_cas), tke_cas(nlev_cas, nt_cas)
     678    REAL du_cas(nlev_cas, nt_cas), hu_cas(nlev_cas, nt_cas), vu_cas(nlev_cas, nt_cas)
     679    REAL dv_cas(nlev_cas, nt_cas), hv_cas(nlev_cas, nt_cas), vv_cas(nlev_cas, nt_cas)
     680    REAL dt_cas(nlev_cas, nt_cas), ht_cas(nlev_cas, nt_cas), vt_cas(nlev_cas, nt_cas)
     681    REAL dth_cas(nlev_cas, nt_cas), hth_cas(nlev_cas, nt_cas), vth_cas(nlev_cas, nt_cas)
     682    REAL dtrad_cas(nlev_cas, nt_cas)
     683    REAL dq_cas(nlev_cas, nt_cas), hq_cas(nlev_cas, nt_cas), vq_cas(nlev_cas, nt_cas)
     684    REAL lat_cas(nt_cas), sens_cas(nt_cas), tkes_cas(nt_cas)
     685    REAL ustar_cas(nt_cas), uw_cas(nlev_cas, nt_cas), vw_cas(nlev_cas, nt_cas)
     686    REAL q1_cas(nlev_cas, nt_cas), q2_cas(nlev_cas, nt_cas)
    701687
    702688    ! outputs:
    703689    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)
     690    REAL t_prof_cas(nlev_cas), theta_prof_cas(nlev_cas), thl_prof_cas(nlev_cas), thv_prof_cas(nlev_cas)
     691    REAL qv_prof_cas(nlev_cas), ql_prof_cas(nlev_cas), qi_prof_cas(nlev_cas)
     692    REAL u_prof_cas(nlev_cas), v_prof_cas(nlev_cas)
     693    REAL ug_prof_cas(nlev_cas), vg_prof_cas(nlev_cas)
     694    REAL temp_nudg_prof_cas(nlev_cas), qv_nudg_prof_cas(nlev_cas)
     695    REAL u_nudg_prof_cas(nlev_cas), v_nudg_prof_cas(nlev_cas)
     696
     697    REAL invtau_temp_nudg_prof_cas(nlev_cas), invtau_qv_nudg_prof_cas(nlev_cas)
     698    REAL invtau_u_nudg_prof_cas(nlev_cas), invtau_v_nudg_prof_cas(nlev_cas)
     699
     700    REAL vitw_prof_cas(nlev_cas), omega_prof_cas(nlev_cas), tke_prof_cas(nlev_cas)
     701    REAL du_prof_cas(nlev_cas), hu_prof_cas(nlev_cas), vu_prof_cas(nlev_cas)
     702    REAL dv_prof_cas(nlev_cas), hv_prof_cas(nlev_cas), vv_prof_cas(nlev_cas)
     703    REAL dt_prof_cas(nlev_cas), ht_prof_cas(nlev_cas), vt_prof_cas(nlev_cas)
     704    REAL dth_prof_cas(nlev_cas), hth_prof_cas(nlev_cas), vth_prof_cas(nlev_cas)
    719705    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)
     706    REAL dq_prof_cas(nlev_cas), hq_prof_cas(nlev_cas), vq_prof_cas(nlev_cas)
     707    REAL lat_prof_cas, sens_prof_cas, tkes_prof_cas, ts_prof_cas, tskin_prof_cas, ps_prof_cas, ustar_prof_cas
     708    REAL uw_prof_cas(nlev_cas), vw_prof_cas(nlev_cas), q1_prof_cas(nlev_cas), q2_prof_cas(nlev_cas)
    723709    ! local:
    724     INTEGER it_cas1, it_cas2,k
    725     REAL timeit,time_cas1,time_cas2,frac
    726 
    727 
    728     PRINT*,'Check time',day1,day_ju_ini_cas,day_deb+1,pdt_cas
     710    INTEGER it_cas1, it_cas2, k
     711    REAL timeit, time_cas1, time_cas2, frac
     712
     713    PRINT*, 'Check time', day1, day_ju_ini_cas, day_deb + 1, pdt_cas
    729714    !       do k=1,nlev_cas
    730715    !       PRINT*,'debut de interp2_case_time, plev_cas=',k,plev_cas(k,1)
    … …  
    761746    !        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
    762747    !       endif
    763     timeit=(day-day_ju_ini_cas)*86400
    764     print *,'day=',day
    765     print *,'day_ju_ini_cas=',day_ju_ini_cas
    766     print *,'pdt_cas=',pdt_cas
    767     print *,'timeit=',timeit
    768     print *,'nt_cas=',nt_cas
     748    timeit = (day - day_ju_ini_cas) * 86400
     749    print *, 'day=', day
     750    print *, 'day_ju_ini_cas=', day_ju_ini_cas
     751    print *, 'pdt_cas=', pdt_cas
     752    print *, 'timeit=', timeit
     753    print *, 'nt_cas=', nt_cas
    769754
    770755    ! Determine the closest observation times:
    … …  
    774759    !       time_cas2=(it_cas2-1)*pdt_cas
    775760
    776     it_cas1=INT(timeit/pdt_cas)+1
     761    it_cas1 = INT(timeit / pdt_cas) + 1
    777762    IF (it_cas1 == nt_cas) THEN
    778        it_cas2=it_cas1
     763      it_cas2 = it_cas1
    779764    ELSE
    780        it_cas2=it_cas1 + 1
     765      it_cas2 = it_cas1 + 1
    781766    ENDIF
    782     time_cas1=(it_cas1-1)*pdt_cas
    783     time_cas2=(it_cas2-1)*pdt_cas
     767    time_cas1 = (it_cas1 - 1) * pdt_cas
     768    time_cas2 = (it_cas2 - 1) * pdt_cas
    784769    !     print *,'timeit,pdt_cas,nt_cas=',timeit,pdt_cas,nt_cas
    785770    !     print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
    786771
    787772    IF (it_cas1 > nt_cas) THEN
    788        WRITE(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
    789             ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit
    790        stop
     773      WRITE(*, *) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
     774              , day, day_ju_ini_cas, it_cas1, it_cas2, timeit
     775      stop
    791776    endif
    792777
    793778    ! time interpolation:
    794779    IF (it_cas1 == it_cas2) THEN
    795        frac=0.
     780      frac = 0.
    796781    ELSE
    797        frac=(time_cas2-timeit)/(time_cas2-time_cas1)
    798        frac=max(frac,0.0)
     782      frac = (time_cas2 - timeit) / (time_cas2 - time_cas1)
     783      frac = max(frac, 0.0)
    799784    ENDIF
    800785
    801786    lat_prof_cas = lat_cas(it_cas2)                                   &
    802          -frac*(lat_cas(it_cas2)-lat_cas(it_cas1))
     787            - frac * (lat_cas(it_cas2) - lat_cas(it_cas1))
    803788    sens_prof_cas = sens_cas(it_cas2)                                 &
    804          -frac*(sens_cas(it_cas2)-sens_cas(it_cas1))
     789            - frac * (sens_cas(it_cas2) - sens_cas(it_cas1))
    805790    tkes_prof_cas = tkes_cas(it_cas2)                                   &
    806          -frac*(tkes_cas(it_cas2)-tkes_cas(it_cas1))
     791            - frac * (tkes_cas(it_cas2) - tkes_cas(it_cas1))
    807792    ts_prof_cas = ts_cas(it_cas2)                                     &
    808          -frac*(ts_cas(it_cas2)-ts_cas(it_cas1))
     793            - frac * (ts_cas(it_cas2) - ts_cas(it_cas1))
    809794    tskin_prof_cas = tskin_cas(it_cas2)                                     &
    810          -frac*(tskin_cas(it_cas2)-tskin_cas(it_cas1))
     795            - frac * (tskin_cas(it_cas2) - tskin_cas(it_cas1))
    811796    ps_prof_cas = ps_cas(it_cas2)                                     &
    812          -frac*(ps_cas(it_cas2)-ps_cas(it_cas1))
     797            - frac * (ps_cas(it_cas2) - ps_cas(it_cas1))
    813798    ustar_prof_cas = ustar_cas(it_cas2)                               &
    814          -frac*(ustar_cas(it_cas2)-ustar_cas(it_cas1))
    815 
    816     do k=1,nlev_cas
    817        plev_prof_cas(k) = plev_cas(k,it_cas2)                           &     
    818             -frac*(plev_cas(k,it_cas2)-plev_cas(k,it_cas1))
    819        t_prof_cas(k) = t_cas(k,it_cas2)                                 &       
    820             -frac*(t_cas(k,it_cas2)-t_cas(k,it_cas1))
    821        !print *,'k,frac,plev_cas1,plev_cas2=',k,frac,plev_cas(k,it_cas1),plev_cas(k,it_cas2)
    822        theta_prof_cas(k) = theta_cas(k,it_cas2)                         &                     
    823             -frac*(theta_cas(k,it_cas2)-theta_cas(k,it_cas1))
    824        thv_prof_cas(k) = thv_cas(k,it_cas2)                             &         
    825             -frac*(thv_cas(k,it_cas2)-thv_cas(k,it_cas1))
    826        thl_prof_cas(k) = thl_cas(k,it_cas2)                             &             
    827             -frac*(thl_cas(k,it_cas2)-thl_cas(k,it_cas1))
    828        qv_prof_cas(k) = qv_cas(k,it_cas2)                               &
    829             -frac*(qv_cas(k,it_cas2)-qv_cas(k,it_cas1))
    830        ql_prof_cas(k) = ql_cas(k,it_cas2)                               &
    831             -frac*(ql_cas(k,it_cas2)-ql_cas(k,it_cas1))
    832        qi_prof_cas(k) = qi_cas(k,it_cas2)                               &
    833             -frac*(qi_cas(k,it_cas2)-qi_cas(k,it_cas1))
    834        u_prof_cas(k) = u_cas(k,it_cas2)                                 &
    835             -frac*(u_cas(k,it_cas2)-u_cas(k,it_cas1))
    836        v_prof_cas(k) = v_cas(k,it_cas2)                                 &
    837             -frac*(v_cas(k,it_cas2)-v_cas(k,it_cas1))
    838        ug_prof_cas(k) = ug_cas(k,it_cas2)                               &
    839             -frac*(ug_cas(k,it_cas2)-ug_cas(k,it_cas1))
    840        vg_prof_cas(k) = vg_cas(k,it_cas2)                               &
    841             -frac*(vg_cas(k,it_cas2)-vg_cas(k,it_cas1))
    842        temp_nudg_prof_cas(k) = temp_nudg_cas(k,it_cas2)                    &
    843             -frac*(temp_nudg_cas(k,it_cas2)-temp_nudg_cas(k,it_cas1))
    844        qv_nudg_prof_cas(k) = qv_nudg_cas(k,it_cas2)                        &
    845             -frac*(qv_nudg_cas(k,it_cas2)-qv_nudg_cas(k,it_cas1))
    846        u_nudg_prof_cas(k) = u_nudg_cas(k,it_cas2)                          &
    847             -frac*(u_nudg_cas(k,it_cas2)-u_nudg_cas(k,it_cas1))
    848        v_nudg_prof_cas(k) = v_nudg_cas(k,it_cas2)                          &
    849             -frac*(v_nudg_cas(k,it_cas2)-v_nudg_cas(k,it_cas1))
    850        invtau_temp_nudg_prof_cas(k) = invtau_temp_nudg_cas(k,it_cas2)                    &
    851             -frac*(invtau_temp_nudg_cas(k,it_cas2)-invtau_temp_nudg_cas(k,it_cas1))
    852        invtau_qv_nudg_prof_cas(k) = invtau_qv_nudg_cas(k,it_cas2)                        &
    853             -frac*(invtau_qv_nudg_cas(k,it_cas2)-invtau_qv_nudg_cas(k,it_cas1))
    854        invtau_u_nudg_prof_cas(k) = invtau_u_nudg_cas(k,it_cas2)                          &
    855             -frac*(invtau_u_nudg_cas(k,it_cas2)-invtau_u_nudg_cas(k,it_cas1))
    856        invtau_v_nudg_prof_cas(k) = invtau_v_nudg_cas(k,it_cas2)                          &
    857             -frac*(invtau_v_nudg_cas(k,it_cas2)-invtau_v_nudg_cas(k,it_cas1))
    858        vitw_prof_cas(k) = vitw_cas(k,it_cas2)                           &
    859             -frac*(vitw_cas(k,it_cas2)-vitw_cas(k,it_cas1))
    860        omega_prof_cas(k) = omega_cas(k,it_cas2)                         &
    861             -frac*(omega_cas(k,it_cas2)-omega_cas(k,it_cas1))
    862        tke_prof_cas(k) = tke_cas(k,it_cas2)                         &
    863             -frac*(tke_cas(k,it_cas2)-tke_cas(k,it_cas1))
    864        du_prof_cas(k) = du_cas(k,it_cas2)                               &
    865             -frac*(du_cas(k,it_cas2)-du_cas(k,it_cas1))
    866        hu_prof_cas(k) = hu_cas(k,it_cas2)                               &
    867             -frac*(hu_cas(k,it_cas2)-hu_cas(k,it_cas1))
    868        vu_prof_cas(k) = vu_cas(k,it_cas2)                               &
    869             -frac*(vu_cas(k,it_cas2)-vu_cas(k,it_cas1))
    870        dv_prof_cas(k) = dv_cas(k,it_cas2)                               &
    871             -frac*(dv_cas(k,it_cas2)-dv_cas(k,it_cas1))
    872        hv_prof_cas(k) = hv_cas(k,it_cas2)                               &
    873             -frac*(hv_cas(k,it_cas2)-hv_cas(k,it_cas1))
    874        vv_prof_cas(k) = vv_cas(k,it_cas2)                               &
    875             -frac*(vv_cas(k,it_cas2)-vv_cas(k,it_cas1))
    876        dt_prof_cas(k) = dt_cas(k,it_cas2)                               &
    877             -frac*(dt_cas(k,it_cas2)-dt_cas(k,it_cas1))
    878        ht_prof_cas(k) = ht_cas(k,it_cas2)                               &
    879             -frac*(ht_cas(k,it_cas2)-ht_cas(k,it_cas1))
    880        vt_prof_cas(k) = vt_cas(k,it_cas2)                               &
    881             -frac*(vt_cas(k,it_cas2)-vt_cas(k,it_cas1))
    882        dth_prof_cas(k) = dth_cas(k,it_cas2)                             &
    883             -frac*(dth_cas(k,it_cas2)-dth_cas(k,it_cas1))
    884        hth_prof_cas(k) = hth_cas(k,it_cas2)                             &
    885             -frac*(hth_cas(k,it_cas2)-hth_cas(k,it_cas1))
    886        vth_prof_cas(k) = vth_cas(k,it_cas2)                             &
    887             -frac*(vth_cas(k,it_cas2)-vth_cas(k,it_cas1))
    888        dtrad_prof_cas(k) = dtrad_cas(k,it_cas2)                         &
    889             -frac*(dtrad_cas(k,it_cas2)-dtrad_cas(k,it_cas1))
    890        dq_prof_cas(k) = dq_cas(k,it_cas2)                               &
    891             -frac*(dq_cas(k,it_cas2)-dq_cas(k,it_cas1))
    892        hq_prof_cas(k) = hq_cas(k,it_cas2)                               &
    893             -frac*(hq_cas(k,it_cas2)-hq_cas(k,it_cas1))
    894        vq_prof_cas(k) = vq_cas(k,it_cas2)                               &
    895             -frac*(vq_cas(k,it_cas2)-vq_cas(k,it_cas1))
    896        uw_prof_cas(k) = uw_cas(k,it_cas2)                                &
    897             -frac*(uw_cas(k,it_cas2)-uw_cas(k,it_cas1))
    898        vw_prof_cas(k) = vw_cas(k,it_cas2)                                &
    899             -frac*(vw_cas(k,it_cas2)-vw_cas(k,it_cas1))
    900        q1_prof_cas(k) = q1_cas(k,it_cas2)                                &
    901             -frac*(q1_cas(k,it_cas2)-q1_cas(k,it_cas1))
    902        q2_prof_cas(k) = q2_cas(k,it_cas2)                                &
    903             -frac*(q2_cas(k,it_cas2)-q2_cas(k,it_cas1))
     799            - frac * (ustar_cas(it_cas2) - ustar_cas(it_cas1))
     800
     801    do k = 1, nlev_cas
     802      plev_prof_cas(k) = plev_cas(k, it_cas2)                           &
     803              - frac * (plev_cas(k, it_cas2) - plev_cas(k, it_cas1))
     804      t_prof_cas(k) = t_cas(k, it_cas2)                                 &
     805              - frac * (t_cas(k, it_cas2) - t_cas(k, it_cas1))
     806      !print *,'k,frac,plev_cas1,plev_cas2=',k,frac,plev_cas(k,it_cas1),plev_cas(k,it_cas2)
     807      theta_prof_cas(k) = theta_cas(k, it_cas2)                         &
     808              - frac * (theta_cas(k, it_cas2) - theta_cas(k, it_cas1))
     809      thv_prof_cas(k) = thv_cas(k, it_cas2)                             &
     810              - frac * (thv_cas(k, it_cas2) - thv_cas(k, it_cas1))
     811      thl_prof_cas(k) = thl_cas(k, it_cas2)                             &
     812              - frac * (thl_cas(k, it_cas2) - thl_cas(k, it_cas1))
     813      qv_prof_cas(k) = qv_cas(k, it_cas2)                               &
     814              - frac * (qv_cas(k, it_cas2) - qv_cas(k, it_cas1))
     815      ql_prof_cas(k) = ql_cas(k, it_cas2)                               &
     816              - frac * (ql_cas(k, it_cas2) - ql_cas(k, it_cas1))
     817      qi_prof_cas(k) = qi_cas(k, it_cas2)                               &
     818              - frac * (qi_cas(k, it_cas2) - qi_cas(k, it_cas1))
     819      u_prof_cas(k) = u_cas(k, it_cas2)                                 &
     820              - frac * (u_cas(k, it_cas2) - u_cas(k, it_cas1))
     821      v_prof_cas(k) = v_cas(k, it_cas2)                                 &
     822              - frac * (v_cas(k, it_cas2) - v_cas(k, it_cas1))
     823      ug_prof_cas(k) = ug_cas(k, it_cas2)                               &
     824              - frac * (ug_cas(k, it_cas2) - ug_cas(k, it_cas1))
     825      vg_prof_cas(k) = vg_cas(k, it_cas2)                               &
     826              - frac * (vg_cas(k, it_cas2) - vg_cas(k, it_cas1))
     827      temp_nudg_prof_cas(k) = temp_nudg_cas(k, it_cas2)                    &
     828              - frac * (temp_nudg_cas(k, it_cas2) - temp_nudg_cas(k, it_cas1))
     829      qv_nudg_prof_cas(k) = qv_nudg_cas(k, it_cas2)                        &
     830              - frac * (qv_nudg_cas(k, it_cas2) - qv_nudg_cas(k, it_cas1))
     831      u_nudg_prof_cas(k) = u_nudg_cas(k, it_cas2)                          &
     832              - frac * (u_nudg_cas(k, it_cas2) - u_nudg_cas(k, it_cas1))
     833      v_nudg_prof_cas(k) = v_nudg_cas(k, it_cas2)                          &
     834              - frac * (v_nudg_cas(k, it_cas2) - v_nudg_cas(k, it_cas1))
     835      invtau_temp_nudg_prof_cas(k) = invtau_temp_nudg_cas(k, it_cas2)                    &
     836              - frac * (invtau_temp_nudg_cas(k, it_cas2) - invtau_temp_nudg_cas(k, it_cas1))
     837      invtau_qv_nudg_prof_cas(k) = invtau_qv_nudg_cas(k, it_cas2)                        &
     838              - frac * (invtau_qv_nudg_cas(k, it_cas2) - invtau_qv_nudg_cas(k, it_cas1))
     839      invtau_u_nudg_prof_cas(k) = invtau_u_nudg_cas(k, it_cas2)                          &
     840              - frac * (invtau_u_nudg_cas(k, it_cas2) - invtau_u_nudg_cas(k, it_cas1))
     841      invtau_v_nudg_prof_cas(k) = invtau_v_nudg_cas(k, it_cas2)                          &
     842              - frac * (invtau_v_nudg_cas(k, it_cas2) - invtau_v_nudg_cas(k, it_cas1))
     843      vitw_prof_cas(k) = vitw_cas(k, it_cas2)                           &
     844              - frac * (vitw_cas(k, it_cas2) - vitw_cas(k, it_cas1))
     845      omega_prof_cas(k) = omega_cas(k, it_cas2)                         &
     846              - frac * (omega_cas(k, it_cas2) - omega_cas(k, it_cas1))
     847      tke_prof_cas(k) = tke_cas(k, it_cas2)                         &
     848              - frac * (tke_cas(k, it_cas2) - tke_cas(k, it_cas1))
     849      du_prof_cas(k) = du_cas(k, it_cas2)                               &
     850              - frac * (du_cas(k, it_cas2) - du_cas(k, it_cas1))
     851      hu_prof_cas(k) = hu_cas(k, it_cas2)                               &
     852              - frac * (hu_cas(k, it_cas2) - hu_cas(k, it_cas1))
     853      vu_prof_cas(k) = vu_cas(k, it_cas2)                               &
     854              - frac * (vu_cas(k, it_cas2) - vu_cas(k, it_cas1))
     855      dv_prof_cas(k) = dv_cas(k, it_cas2)                               &
     856              - frac * (dv_cas(k, it_cas2) - dv_cas(k, it_cas1))
     857      hv_prof_cas(k) = hv_cas(k, it_cas2)                               &
     858              - frac * (hv_cas(k, it_cas2) - hv_cas(k, it_cas1))
     859      vv_prof_cas(k) = vv_cas(k, it_cas2)                               &
     860              - frac * (vv_cas(k, it_cas2) - vv_cas(k, it_cas1))
     861      dt_prof_cas(k) = dt_cas(k, it_cas2)                               &
     862              - frac * (dt_cas(k, it_cas2) - dt_cas(k, it_cas1))
     863      ht_prof_cas(k) = ht_cas(k, it_cas2)                               &
     864              - frac * (ht_cas(k, it_cas2) - ht_cas(k, it_cas1))
     865      vt_prof_cas(k) = vt_cas(k, it_cas2)                               &
     866              - frac * (vt_cas(k, it_cas2) - vt_cas(k, it_cas1))
     867      dth_prof_cas(k) = dth_cas(k, it_cas2)                             &
     868              - frac * (dth_cas(k, it_cas2) - dth_cas(k, it_cas1))
     869      hth_prof_cas(k) = hth_cas(k, it_cas2)                             &
     870              - frac * (hth_cas(k, it_cas2) - hth_cas(k, it_cas1))
     871      vth_prof_cas(k) = vth_cas(k, it_cas2)                             &
     872              - frac * (vth_cas(k, it_cas2) - vth_cas(k, it_cas1))
     873      dtrad_prof_cas(k) = dtrad_cas(k, it_cas2)                         &
     874              - frac * (dtrad_cas(k, it_cas2) - dtrad_cas(k, it_cas1))
     875      dq_prof_cas(k) = dq_cas(k, it_cas2)                               &
     876              - frac * (dq_cas(k, it_cas2) - dq_cas(k, it_cas1))
     877      hq_prof_cas(k) = hq_cas(k, it_cas2)                               &
     878              - frac * (hq_cas(k, it_cas2) - hq_cas(k, it_cas1))
     879      vq_prof_cas(k) = vq_cas(k, it_cas2)                               &
     880              - frac * (vq_cas(k, it_cas2) - vq_cas(k, it_cas1))
     881      uw_prof_cas(k) = uw_cas(k, it_cas2)                                &
     882              - frac * (uw_cas(k, it_cas2) - uw_cas(k, it_cas1))
     883      vw_prof_cas(k) = vw_cas(k, it_cas2)                                &
     884              - frac * (vw_cas(k, it_cas2) - vw_cas(k, it_cas1))
     885      q1_prof_cas(k) = q1_cas(k, it_cas2)                                &
     886              - frac * (q1_cas(k, it_cas2) - q1_cas(k, it_cas1))
     887      q2_prof_cas(k) = q2_cas(k, it_cas2)                                &
     888              - frac * (q2_cas(k, it_cas2) - q2_cas(k, it_cas1))
    904889    enddo
    905 
    906890
    907891  END SUBROUTINE interp_case_time_std
    … …  
    909893  !**********************************************************************************************
    910894  !=====================================================================
    911   SUBROUTINE interp2_case_vertical_std(play,plev,nlev_cas,plev_prof_cas                           &
    912        ,t_prof_cas,th_prof_cas,thv_prof_cas,thl_prof_cas                                       &
    913        ,qv_prof_cas,ql_prof_cas,qi_prof_cas,u_prof_cas,v_prof_cas                              &
    914        ,ug_prof_cas,vg_prof_cas                                                                &
    915        ,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas                    &
    916        ,invtau_temp_nudg_prof_cas,invtau_qv_nudg_prof_cas,invtau_u_nudg_prof_cas,invtau_v_nudg_prof_cas &     
    917        ,vitw_prof_cas,omega_prof_cas,tke_prof_cas                                              &
    918        ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas                &
    919        ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas &
    920        ,dth_prof_cas,hth_prof_cas,vth_prof_cas                                                 &
    921 
    922        ,t_mod_cas,theta_mod_cas,thv_mod_cas,thl_mod_cas                                        &
    923        ,qv_mod_cas,ql_mod_cas,qi_mod_cas,u_mod_cas,v_mod_cas                                   &
    924        ,ug_mod_cas,vg_mod_cas                                                                  &
    925        ,temp_nudg_mod_cas,qv_nudg_mod_cas,u_nudg_mod_cas,v_nudg_mod_cas                        &
    926        ,invtau_temp_nudg_mod_cas,invtau_qv_nudg_mod_cas,invtau_u_nudg_mod_cas,invtau_v_nudg_mod_cas                        &     
    927        ,w_mod_cas,omega_mod_cas,tke_mod_cas                                                    &
    928        ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas                      &
    929        ,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas        &
    930        ,dth_mod_cas,hth_mod_cas,vth_mod_cas,mxcalc)
     895  SUBROUTINE interp2_case_vertical_std(play, plev, nlev_cas, plev_prof_cas                           &
     896          , t_prof_cas, th_prof_cas, thv_prof_cas, thl_prof_cas                                       &
     897          , qv_prof_cas, ql_prof_cas, qi_prof_cas, u_prof_cas, v_prof_cas                              &
     898          , ug_prof_cas, vg_prof_cas                                                                &
     899          , temp_nudg_prof_cas, qv_nudg_prof_cas, u_nudg_prof_cas, v_nudg_prof_cas                    &
     900          , invtau_temp_nudg_prof_cas, invtau_qv_nudg_prof_cas, invtau_u_nudg_prof_cas, invtau_v_nudg_prof_cas &
     901          , vitw_prof_cas, omega_prof_cas, tke_prof_cas                                              &
     902          , du_prof_cas, hu_prof_cas, vu_prof_cas, dv_prof_cas, hv_prof_cas, vv_prof_cas                &
     903          , dt_prof_cas, ht_prof_cas, vt_prof_cas, dtrad_prof_cas, dq_prof_cas, hq_prof_cas, vq_prof_cas &
     904          , dth_prof_cas, hth_prof_cas, vth_prof_cas                                                 &
     905
     906          , t_mod_cas, theta_mod_cas, thv_mod_cas, thl_mod_cas                                        &
     907          , qv_mod_cas, ql_mod_cas, qi_mod_cas, u_mod_cas, v_mod_cas                                   &
     908          , ug_mod_cas, vg_mod_cas                                                                  &
     909          , temp_nudg_mod_cas, qv_nudg_mod_cas, u_nudg_mod_cas, v_nudg_mod_cas                        &
     910          , invtau_temp_nudg_mod_cas, invtau_qv_nudg_mod_cas, invtau_u_nudg_mod_cas, invtau_v_nudg_mod_cas                        &
     911          , w_mod_cas, omega_mod_cas, tke_mod_cas                                                    &
     912          , du_mod_cas, hu_mod_cas, vu_mod_cas, dv_mod_cas, hv_mod_cas, vv_mod_cas                      &
     913          , dt_mod_cas, ht_mod_cas, vt_mod_cas, dtrad_mod_cas, dq_mod_cas, hq_mod_cas, vq_mod_cas        &
     914          , dth_mod_cas, hth_mod_cas, vth_mod_cas, mxcalc)
     915
     916    USE lmdz_yomcst
    931917
    932918    IMPLICIT NONE
    933919
    934     INCLUDE "YOMCST.h"
    935920    INCLUDE "dimensions.h"
    936921
    … …  
    940925
    941926    INTEGER nlevmax
    942     parameter (nlevmax=41)
    943     INTEGER nlev_cas,mxcalc
    944     !       real play(llm), plev_prof(nlevmax) 
     927    parameter (nlevmax = 41)
     928    INTEGER nlev_cas, mxcalc
     929    !       real play(llm), plev_prof(nlevmax)
    945930    !       real t_prof(nlevmax),q_prof(nlevmax)
    946931    !       real u_prof(nlevmax),v_prof(nlevmax), w_prof(nlevmax)
    … …  
    948933    !       real hq_prof(nlevmax),vq_prof(nlevmax)
    949934
    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
     935    REAL play(llm), plev(llm + 1), plev_prof_cas(nlev_cas)
     936    REAL t_prof_cas(nlev_cas), th_prof_cas(nlev_cas), thv_prof_cas(nlev_cas), thl_prof_cas(nlev_cas)
     937    REAL qv_prof_cas(nlev_cas), ql_prof_cas(nlev_cas), qi_prof_cas(nlev_cas)
     938    REAL u_prof_cas(nlev_cas), v_prof_cas(nlev_cas)
     939    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)
     940    REAL temp_nudg_prof_cas(nlev_cas), qv_nudg_prof_cas(nlev_cas)
     941    REAL u_nudg_prof_cas(nlev_cas), v_nudg_prof_cas(nlev_cas)
     942    REAL invtau_temp_nudg_prof_cas(nlev_cas), invtau_qv_nudg_prof_cas(nlev_cas)
     943    REAL invtau_u_nudg_prof_cas(nlev_cas), invtau_v_nudg_prof_cas(nlev_cas)
     944
     945    REAL du_prof_cas(nlev_cas), hu_prof_cas(nlev_cas), vu_prof_cas(nlev_cas)
     946    REAL dv_prof_cas(nlev_cas), hv_prof_cas(nlev_cas), vv_prof_cas(nlev_cas)
     947    REAL dt_prof_cas(nlev_cas), ht_prof_cas(nlev_cas), vt_prof_cas(nlev_cas), dtrad_prof_cas(nlev_cas)
     948    REAL dth_prof_cas(nlev_cas), hth_prof_cas(nlev_cas), vth_prof_cas(nlev_cas)
     949    REAL dq_prof_cas(nlev_cas), hq_prof_cas(nlev_cas), vq_prof_cas(nlev_cas)
     950
     951    REAL t_mod_cas(llm), theta_mod_cas(llm), thv_mod_cas(llm), thl_mod_cas(llm)
     952    REAL qv_mod_cas(llm), ql_mod_cas(llm), qi_mod_cas(llm)
     953    REAL u_mod_cas(llm), v_mod_cas(llm)
     954    REAL ug_mod_cas(llm), vg_mod_cas(llm), w_mod_cas(llm), omega_mod_cas(llm), tke_mod_cas(llm + 1)
     955    REAL temp_nudg_mod_cas(llm), qv_nudg_mod_cas(llm)
     956    REAL u_nudg_mod_cas(llm), v_nudg_mod_cas(llm)
     957    REAL invtau_temp_nudg_mod_cas(llm), invtau_qv_nudg_mod_cas(llm)
     958    REAL invtau_u_nudg_mod_cas(llm), invtau_v_nudg_mod_cas(llm)
     959    REAL du_mod_cas(llm), hu_mod_cas(llm), vu_mod_cas(llm)
     960    REAL dv_mod_cas(llm), hv_mod_cas(llm), vv_mod_cas(llm)
     961    REAL dt_mod_cas(llm), ht_mod_cas(llm), vt_mod_cas(llm), dtrad_mod_cas(llm)
     962    REAL dth_mod_cas(llm), hth_mod_cas(llm), vth_mod_cas(llm)
     963    REAL dq_mod_cas(llm), hq_mod_cas(llm), vq_mod_cas(llm)
     964
     965    INTEGER l, k, k1, k2
     966    REAL frac, frac1, frac2, fact
    982967
    983968
    … …  
    987972    do l = 1, llm
    988973
    989        IF (play(l)>=plev_prof_cas(nlev_cas)) THEN
    990           mxcalc=l
    991           !        print *,'debut interp2, mxcalc=',mxcalc
    992           k1=0
    993           k2=0
    994 
    995           IF (play(l)<=plev_prof_cas(1)) THEN
    996              do k = 1, nlev_cas-1
    997                 IF (play(l)<=plev_prof_cas(k).AND. play(l)>plev_prof_cas(k+1)) THEN
    998                    k1=k
    999                    k2=k+1
    1000                 endif
    1001              enddo
    1002 
    1003              IF (k1==0 .OR. k2==0) THEN
    1004                 WRITE(*,*) 'PB! k1, k2 = ',k1,k2
    1005                 WRITE(*,*) 'l,play(l) = ',l,play(l)/100
    1006                 do k = 1, nlev_cas-1
    1007                    WRITE(*,*) 'k,plev_prof_cas(k) = ',k,plev_prof_cas(k)/100
    1008                 enddo
    1009              endif
    1010 
    1011 
    1012 
    1013              frac = (plev_prof_cas(k2)-play(l))/(plev_prof_cas(k2)-plev_prof_cas(k1))
    1014 
    1015              t_mod_cas(l)= t_prof_cas(k2) - frac*(t_prof_cas(k2)-t_prof_cas(k1))
    1016              theta_mod_cas(l)= th_prof_cas(k2) - frac*(th_prof_cas(k2)-th_prof_cas(k1))
    1017              IF(theta_mod_cas(l)/=0) t_mod_cas(l)= theta_mod_cas(l)*(play(l)/100000.)**(RD/RCPD)
    1018              thv_mod_cas(l)= thv_prof_cas(k2) - frac*(thv_prof_cas(k2)-thv_prof_cas(k1))
    1019              thl_mod_cas(l)= thl_prof_cas(k2) - frac*(thl_prof_cas(k2)-thl_prof_cas(k1))
    1020              qv_mod_cas(l)= qv_prof_cas(k2) - frac*(qv_prof_cas(k2)-qv_prof_cas(k1))
    1021              ql_mod_cas(l)= ql_prof_cas(k2) - frac*(ql_prof_cas(k2)-ql_prof_cas(k1))
    1022              qi_mod_cas(l)= qi_prof_cas(k2) - frac*(qi_prof_cas(k2)-qi_prof_cas(k1))
    1023              u_mod_cas(l)= u_prof_cas(k2) - frac*(u_prof_cas(k2)-u_prof_cas(k1))
    1024              v_mod_cas(l)= v_prof_cas(k2) - frac*(v_prof_cas(k2)-v_prof_cas(k1))
    1025              ug_mod_cas(l)= ug_prof_cas(k2) - frac*(ug_prof_cas(k2)-ug_prof_cas(k1))
    1026              vg_mod_cas(l)= vg_prof_cas(k2) - frac*(vg_prof_cas(k2)-vg_prof_cas(k1))
    1027              temp_nudg_mod_cas(l)= temp_nudg_prof_cas(k2) - frac*(temp_nudg_prof_cas(k2)-temp_nudg_prof_cas(k1))
    1028              qv_nudg_mod_cas(l)= qv_nudg_prof_cas(k2) - frac*(qv_nudg_prof_cas(k2)-qv_nudg_prof_cas(k1))
    1029              u_nudg_mod_cas(l)= u_nudg_prof_cas(k2) - frac*(u_nudg_prof_cas(k2)-u_nudg_prof_cas(k1))
    1030              v_nudg_mod_cas(l)= v_nudg_prof_cas(k2) - frac*(v_nudg_prof_cas(k2)-v_nudg_prof_cas(k1))
    1031 
    1032              invtau_temp_nudg_mod_cas(l)= invtau_temp_nudg_prof_cas(k2) &
    1033                   - frac*(invtau_temp_nudg_prof_cas(k2)-invtau_temp_nudg_prof_cas(k1))
    1034              invtau_qv_nudg_mod_cas(l)= invtau_qv_nudg_prof_cas(k2) - frac*(invtau_qv_nudg_prof_cas(k2)-invtau_qv_nudg_prof_cas(k1))
    1035              invtau_u_nudg_mod_cas(l)= invtau_u_nudg_prof_cas(k2) - frac*(invtau_u_nudg_prof_cas(k2)-invtau_u_nudg_prof_cas(k1))
    1036              invtau_v_nudg_mod_cas(l)= invtau_v_nudg_prof_cas(k2) - frac*(invtau_v_nudg_prof_cas(k2)-invtau_v_nudg_prof_cas(k1))
    1037 
    1038              w_mod_cas(l)= vitw_prof_cas(k2) - frac*(vitw_prof_cas(k2)-vitw_prof_cas(k1))
    1039              omega_mod_cas(l)= omega_prof_cas(k2) - frac*(omega_prof_cas(k2)-omega_prof_cas(k1))
    1040              du_mod_cas(l)= du_prof_cas(k2) - frac*(du_prof_cas(k2)-du_prof_cas(k1))
    1041              hu_mod_cas(l)= hu_prof_cas(k2) - frac*(hu_prof_cas(k2)-hu_prof_cas(k1))
    1042              vu_mod_cas(l)= vu_prof_cas(k2) - frac*(vu_prof_cas(k2)-vu_prof_cas(k1))
    1043              dv_mod_cas(l)= dv_prof_cas(k2) - frac*(dv_prof_cas(k2)-dv_prof_cas(k1))
    1044              hv_mod_cas(l)= hv_prof_cas(k2) - frac*(hv_prof_cas(k2)-hv_prof_cas(k1))
    1045              vv_mod_cas(l)= vv_prof_cas(k2) - frac*(vv_prof_cas(k2)-vv_prof_cas(k1))
    1046              dt_mod_cas(l)= dt_prof_cas(k2) - frac*(dt_prof_cas(k2)-dt_prof_cas(k1))
    1047              ht_mod_cas(l)= ht_prof_cas(k2) - frac*(ht_prof_cas(k2)-ht_prof_cas(k1))
    1048              vt_mod_cas(l)= vt_prof_cas(k2) - frac*(vt_prof_cas(k2)-vt_prof_cas(k1))
    1049              dth_mod_cas(l)= dth_prof_cas(k2) - frac*(dth_prof_cas(k2)-dth_prof_cas(k1))
    1050              hth_mod_cas(l)= hth_prof_cas(k2) - frac*(hth_prof_cas(k2)-hth_prof_cas(k1))
    1051              vth_mod_cas(l)= vth_prof_cas(k2) - frac*(vth_prof_cas(k2)-vth_prof_cas(k1))
    1052              dq_mod_cas(l)= dq_prof_cas(k2) - frac*(dq_prof_cas(k2)-dq_prof_cas(k1))
    1053              hq_mod_cas(l)= hq_prof_cas(k2) - frac*(hq_prof_cas(k2)-hq_prof_cas(k1))
    1054              vq_mod_cas(l)= vq_prof_cas(k2) - frac*(vq_prof_cas(k2)-vq_prof_cas(k1))
    1055              dtrad_mod_cas(l)= dtrad_prof_cas(k2) - frac*(dtrad_prof_cas(k2)-dtrad_prof_cas(k1))
    1056 
    1057           else !play>plev_prof_cas(1)
    1058 
    1059              k1=1
    1060              k2=2
    1061              print *,'interp2_vert, k1,k2=',plev_prof_cas(k1),plev_prof_cas(k2)
    1062              frac1 = (play(l)-plev_prof_cas(k2))/(plev_prof_cas(k1)-plev_prof_cas(k2))
    1063              frac2 = (play(l)-plev_prof_cas(k1))/(plev_prof_cas(k1)-plev_prof_cas(k2))
    1064              t_mod_cas(l)= frac1*t_prof_cas(k1) - frac2*t_prof_cas(k2)
    1065              theta_mod_cas(l)= frac1*th_prof_cas(k1) - frac2*th_prof_cas(k2)
    1066              IF(theta_mod_cas(l)/=0) t_mod_cas(l)= theta_mod_cas(l)*(play(l)/100000.)**(RD/RCPD)
    1067              thv_mod_cas(l)= frac1*thv_prof_cas(k1) - frac2*thv_prof_cas(k2)
    1068              thl_mod_cas(l)= frac1*thl_prof_cas(k1) - frac2*thl_prof_cas(k2)
    1069              qv_mod_cas(l)= frac1*qv_prof_cas(k1) - frac2*qv_prof_cas(k2)
    1070              ql_mod_cas(l)= frac1*ql_prof_cas(k1) - frac2*ql_prof_cas(k2)
    1071              qi_mod_cas(l)= frac1*qi_prof_cas(k1) - frac2*qi_prof_cas(k2)
    1072              u_mod_cas(l)= frac1*u_prof_cas(k1) - frac2*u_prof_cas(k2)
    1073              v_mod_cas(l)= frac1*v_prof_cas(k1) - frac2*v_prof_cas(k2)
    1074              ug_mod_cas(l)= frac1*ug_prof_cas(k1) - frac2*ug_prof_cas(k2)
    1075              vg_mod_cas(l)= frac1*vg_prof_cas(k1) - frac2*vg_prof_cas(k2)
    1076              temp_nudg_mod_cas(l)= frac1*temp_nudg_prof_cas(k1) - frac2*temp_nudg_prof_cas(k2)
    1077              qv_nudg_mod_cas(l)= frac1*qv_nudg_prof_cas(k1) - frac2*qv_nudg_prof_cas(k2)
    1078              u_nudg_mod_cas(l)= frac1*u_nudg_prof_cas(k1) - frac2*u_nudg_prof_cas(k2)
    1079              v_nudg_mod_cas(l)= frac1*v_nudg_prof_cas(k1) - frac2*v_nudg_prof_cas(k2)
    1080 
    1081              invtau_temp_nudg_mod_cas(l)= frac1*invtau_temp_nudg_prof_cas(k1) - frac2*invtau_temp_nudg_prof_cas(k2)
    1082              invtau_qv_nudg_mod_cas(l)= frac1*invtau_qv_nudg_prof_cas(k1) - frac2*invtau_qv_nudg_prof_cas(k2)
    1083              invtau_u_nudg_mod_cas(l)= frac1*invtau_u_nudg_prof_cas(k1) - frac2*invtau_u_nudg_prof_cas(k2)
    1084              invtau_v_nudg_mod_cas(l)= frac1*invtau_v_nudg_prof_cas(k1) - frac2*invtau_v_nudg_prof_cas(k2)
    1085 
    1086              w_mod_cas(l)= frac1*vitw_prof_cas(k1) - frac2*vitw_prof_cas(k2)
    1087              omega_mod_cas(l)= frac1*omega_prof_cas(k1) - frac2*omega_prof_cas(k2)
    1088              du_mod_cas(l)= frac1*du_prof_cas(k1) - frac2*du_prof_cas(k2)
    1089              hu_mod_cas(l)= frac1*hu_prof_cas(k1) - frac2*hu_prof_cas(k2)
    1090              vu_mod_cas(l)= frac1*vu_prof_cas(k1) - frac2*vu_prof_cas(k2)
    1091              dv_mod_cas(l)= frac1*dv_prof_cas(k1) - frac2*dv_prof_cas(k2)
    1092              hv_mod_cas(l)= frac1*hv_prof_cas(k1) - frac2*hv_prof_cas(k2)
    1093              vv_mod_cas(l)= frac1*vv_prof_cas(k1) - frac2*vv_prof_cas(k2)
    1094              dt_mod_cas(l)= frac1*dt_prof_cas(k1) - frac2*dt_prof_cas(k2)
    1095              ht_mod_cas(l)= frac1*ht_prof_cas(k1) - frac2*ht_prof_cas(k2)
    1096              vt_mod_cas(l)= frac1*vt_prof_cas(k1) - frac2*vt_prof_cas(k2)
    1097              dth_mod_cas(l)= frac1*dth_prof_cas(k1) - frac2*dth_prof_cas(k2)
    1098              hth_mod_cas(l)= frac1*hth_prof_cas(k1) - frac2*hth_prof_cas(k2)
    1099              vth_mod_cas(l)= frac1*vth_prof_cas(k1) - frac2*vth_prof_cas(k2)
    1100              dq_mod_cas(l)= frac1*dq_prof_cas(k1) - frac2*dq_prof_cas(k2)
    1101              hq_mod_cas(l)= frac1*hq_prof_cas(k1) - frac2*hq_prof_cas(k2)
    1102              vq_mod_cas(l)= frac1*vq_prof_cas(k1) - frac2*vq_prof_cas(k2)
    1103              dtrad_mod_cas(l)= frac1*dtrad_prof_cas(k1) - frac2*dtrad_prof_cas(k2)
    1104 
    1105           endif ! play.le.plev_prof_cas(1)
    1106 
    1107        else ! above max altitude of forcing file
    1108 
    1109           !jyg
    1110           fact=20.*(plev_prof_cas(nlev_cas)-play(l))/plev_prof_cas(nlev_cas) !jyg
    1111           fact = max(fact,0.)                                           !jyg
    1112           fact = exp(-fact)                                             !jyg
    1113           t_mod_cas(l)= t_prof_cas(nlev_cas)                            !jyg
    1114           theta_mod_cas(l)= th_prof_cas(nlev_cas)                       !jyg
    1115           thv_mod_cas(l)= thv_prof_cas(nlev_cas)                        !jyg
    1116           thl_mod_cas(l)= thl_prof_cas(nlev_cas)                        !jyg
    1117           qv_mod_cas(l)= qv_prof_cas(nlev_cas)*fact                     !jyg
    1118           ql_mod_cas(l)= ql_prof_cas(nlev_cas)*fact                     !jyg
    1119           qi_mod_cas(l)= qi_prof_cas(nlev_cas)*fact                     !jyg
    1120           u_mod_cas(l)= u_prof_cas(nlev_cas)*fact                       !jyg
    1121           v_mod_cas(l)= v_prof_cas(nlev_cas)*fact                       !jyg
    1122           ug_mod_cas(l)= ug_prof_cas(nlev_cas)                          !jyg
    1123           vg_mod_cas(l)= vg_prof_cas(nlev_cas)                          !jyg
    1124           temp_nudg_mod_cas(l)= temp_nudg_prof_cas(nlev_cas)            !jyg
    1125           qv_nudg_mod_cas(l)= qv_nudg_prof_cas(nlev_cas)                !jyg
    1126           u_nudg_mod_cas(l)= u_nudg_prof_cas(nlev_cas)                  !jyg
    1127           v_nudg_mod_cas(l)= v_nudg_prof_cas(nlev_cas)                  !jyg
    1128 
    1129           invtau_temp_nudg_mod_cas(l)= invtau_temp_nudg_prof_cas(nlev_cas)            !jyg
    1130           invtau_qv_nudg_mod_cas(l)= invtau_qv_nudg_prof_cas(nlev_cas)                !jyg
    1131           invtau_u_nudg_mod_cas(l)= invtau_u_nudg_prof_cas(nlev_cas)                  !jyg
    1132           invtau_v_nudg_mod_cas(l)= invtau_v_nudg_prof_cas(nlev_cas)                  !jyg
    1133 
    1134           thv_mod_cas(l)= thv_prof_cas(nlev_cas)                        !jyg
    1135           w_mod_cas(l)= 0.0                                             !jyg
    1136           omega_mod_cas(l)= 0.0                                         !jyg
    1137           du_mod_cas(l)= du_prof_cas(nlev_cas)*fact
    1138           hu_mod_cas(l)= hu_prof_cas(nlev_cas)*fact                     !jyg
    1139           vu_mod_cas(l)= vu_prof_cas(nlev_cas)*fact                     !jyg
    1140           dv_mod_cas(l)= dv_prof_cas(nlev_cas)*fact
    1141           hv_mod_cas(l)= hv_prof_cas(nlev_cas)*fact                     !jyg
    1142           vv_mod_cas(l)= vv_prof_cas(nlev_cas)*fact                     !jyg
    1143           dt_mod_cas(l)= dt_prof_cas(nlev_cas)
    1144           ht_mod_cas(l)= ht_prof_cas(nlev_cas)                          !jyg
    1145           vt_mod_cas(l)= vt_prof_cas(nlev_cas)                          !jyg
    1146           dth_mod_cas(l)= dth_prof_cas(nlev_cas)
    1147           hth_mod_cas(l)= hth_prof_cas(nlev_cas)                        !jyg
    1148           vth_mod_cas(l)= vth_prof_cas(nlev_cas)                        !jyg
    1149           dq_mod_cas(l)= dq_prof_cas(nlev_cas)*fact
    1150           hq_mod_cas(l)= hq_prof_cas(nlev_cas)*fact                     !jyg
    1151           vq_mod_cas(l)= vq_prof_cas(nlev_cas)*fact                     !jyg
    1152           dtrad_mod_cas(l)= dtrad_prof_cas(nlev_cas)*fact               !jyg
    1153 
    1154        endif ! play
     974      IF (play(l)>=plev_prof_cas(nlev_cas)) THEN
     975        mxcalc = l
     976        !        print *,'debut interp2, mxcalc=',mxcalc
     977        k1 = 0
     978        k2 = 0
     979
     980        IF (play(l)<=plev_prof_cas(1)) THEN
     981          do k = 1, nlev_cas - 1
     982            IF (play(l)<=plev_prof_cas(k).AND. play(l)>plev_prof_cas(k + 1)) THEN
     983              k1 = k
     984              k2 = k + 1
     985            endif
     986          enddo
     987
     988          IF (k1==0 .OR. k2==0) THEN
     989            WRITE(*, *) 'PB! k1, k2 = ', k1, k2
     990            WRITE(*, *) 'l,play(l) = ', l, play(l) / 100
     991            do k = 1, nlev_cas - 1
     992              WRITE(*, *) 'k,plev_prof_cas(k) = ', k, plev_prof_cas(k) / 100
     993            enddo
     994          endif
     995
     996          frac = (plev_prof_cas(k2) - play(l)) / (plev_prof_cas(k2) - plev_prof_cas(k1))
     997
     998          t_mod_cas(l) = t_prof_cas(k2) - frac * (t_prof_cas(k2) - t_prof_cas(k1))
     999          theta_mod_cas(l) = th_prof_cas(k2) - frac * (th_prof_cas(k2) - th_prof_cas(k1))
     1000          IF(theta_mod_cas(l)/=0) t_mod_cas(l) = theta_mod_cas(l) * (play(l) / 100000.)**(RD / RCPD)
     1001          thv_mod_cas(l) = thv_prof_cas(k2) - frac * (thv_prof_cas(k2) - thv_prof_cas(k1))
     1002          thl_mod_cas(l) = thl_prof_cas(k2) - frac * (thl_prof_cas(k2) - thl_prof_cas(k1))
     1003          qv_mod_cas(l) = qv_prof_cas(k2) - frac * (qv_prof_cas(k2) - qv_prof_cas(k1))
     1004          ql_mod_cas(l) = ql_prof_cas(k2) - frac * (ql_prof_cas(k2) - ql_prof_cas(k1))
     1005          qi_mod_cas(l) = qi_prof_cas(k2) - frac * (qi_prof_cas(k2) - qi_prof_cas(k1))
     1006          u_mod_cas(l) = u_prof_cas(k2) - frac * (u_prof_cas(k2) - u_prof_cas(k1))
     1007          v_mod_cas(l) = v_prof_cas(k2) - frac * (v_prof_cas(k2) - v_prof_cas(k1))
     1008          ug_mod_cas(l) = ug_prof_cas(k2) - frac * (ug_prof_cas(k2) - ug_prof_cas(k1))
     1009          vg_mod_cas(l) = vg_prof_cas(k2) - frac * (vg_prof_cas(k2) - vg_prof_cas(k1))
     1010          temp_nudg_mod_cas(l) = temp_nudg_prof_cas(k2) - frac * (temp_nudg_prof_cas(k2) - temp_nudg_prof_cas(k1))
     1011          qv_nudg_mod_cas(l) = qv_nudg_prof_cas(k2) - frac * (qv_nudg_prof_cas(k2) - qv_nudg_prof_cas(k1))
     1012          u_nudg_mod_cas(l) = u_nudg_prof_cas(k2) - frac * (u_nudg_prof_cas(k2) - u_nudg_prof_cas(k1))
     1013          v_nudg_mod_cas(l) = v_nudg_prof_cas(k2) - frac * (v_nudg_prof_cas(k2) - v_nudg_prof_cas(k1))
     1014
     1015          invtau_temp_nudg_mod_cas(l) = invtau_temp_nudg_prof_cas(k2) &
     1016                  - frac * (invtau_temp_nudg_prof_cas(k2) - invtau_temp_nudg_prof_cas(k1))
     1017          invtau_qv_nudg_mod_cas(l) = invtau_qv_nudg_prof_cas(k2) - frac * (invtau_qv_nudg_prof_cas(k2) - invtau_qv_nudg_prof_cas(k1))
     1018          invtau_u_nudg_mod_cas(l) = invtau_u_nudg_prof_cas(k2) - frac * (invtau_u_nudg_prof_cas(k2) - invtau_u_nudg_prof_cas(k1))
     1019          invtau_v_nudg_mod_cas(l) = invtau_v_nudg_prof_cas(k2) - frac * (invtau_v_nudg_prof_cas(k2) - invtau_v_nudg_prof_cas(k1))
     1020
     1021          w_mod_cas(l) = vitw_prof_cas(k2) - frac * (vitw_prof_cas(k2) - vitw_prof_cas(k1))
     1022          omega_mod_cas(l) = omega_prof_cas(k2) - frac * (omega_prof_cas(k2) - omega_prof_cas(k1))
     1023          du_mod_cas(l) = du_prof_cas(k2) - frac * (du_prof_cas(k2) - du_prof_cas(k1))
     1024          hu_mod_cas(l) = hu_prof_cas(k2) - frac * (hu_prof_cas(k2) - hu_prof_cas(k1))
     1025          vu_mod_cas(l) = vu_prof_cas(k2) - frac * (vu_prof_cas(k2) - vu_prof_cas(k1))
     1026          dv_mod_cas(l) = dv_prof_cas(k2) - frac * (dv_prof_cas(k2) - dv_prof_cas(k1))
     1027          hv_mod_cas(l) = hv_prof_cas(k2) - frac * (hv_prof_cas(k2) - hv_prof_cas(k1))
     1028          vv_mod_cas(l) = vv_prof_cas(k2) - frac * (vv_prof_cas(k2) - vv_prof_cas(k1))
     1029          dt_mod_cas(l) = dt_prof_cas(k2) - frac * (dt_prof_cas(k2) - dt_prof_cas(k1))
     1030          ht_mod_cas(l) = ht_prof_cas(k2) - frac * (ht_prof_cas(k2) - ht_prof_cas(k1))
     1031          vt_mod_cas(l) = vt_prof_cas(k2) - frac * (vt_prof_cas(k2) - vt_prof_cas(k1))
     1032          dth_mod_cas(l) = dth_prof_cas(k2) - frac * (dth_prof_cas(k2) - dth_prof_cas(k1))
     1033          hth_mod_cas(l) = hth_prof_cas(k2) - frac * (hth_prof_cas(k2) - hth_prof_cas(k1))
     1034          vth_mod_cas(l) = vth_prof_cas(k2) - frac * (vth_prof_cas(k2) - vth_prof_cas(k1))
     1035          dq_mod_cas(l) = dq_prof_cas(k2) - frac * (dq_prof_cas(k2) - dq_prof_cas(k1))
     1036          hq_mod_cas(l) = hq_prof_cas(k2) - frac * (hq_prof_cas(k2) - hq_prof_cas(k1))
     1037          vq_mod_cas(l) = vq_prof_cas(k2) - frac * (vq_prof_cas(k2) - vq_prof_cas(k1))
     1038          dtrad_mod_cas(l) = dtrad_prof_cas(k2) - frac * (dtrad_prof_cas(k2) - dtrad_prof_cas(k1))
     1039
     1040        else !play>plev_prof_cas(1)
     1041
     1042          k1 = 1
     1043          k2 = 2
     1044          print *, 'interp2_vert, k1,k2=', plev_prof_cas(k1), plev_prof_cas(k2)
     1045          frac1 = (play(l) - plev_prof_cas(k2)) / (plev_prof_cas(k1) - plev_prof_cas(k2))
     1046          frac2 = (play(l) - plev_prof_cas(k1)) / (plev_prof_cas(k1) - plev_prof_cas(k2))
     1047          t_mod_cas(l) = frac1 * t_prof_cas(k1) - frac2 * t_prof_cas(k2)
     1048          theta_mod_cas(l) = frac1 * th_prof_cas(k1) - frac2 * th_prof_cas(k2)
     1049          IF(theta_mod_cas(l)/=0) t_mod_cas(l) = theta_mod_cas(l) * (play(l) / 100000.)**(RD / RCPD)
     1050          thv_mod_cas(l) = frac1 * thv_prof_cas(k1) - frac2 * thv_prof_cas(k2)
     1051          thl_mod_cas(l) = frac1 * thl_prof_cas(k1) - frac2 * thl_prof_cas(k2)
     1052          qv_mod_cas(l) = frac1 * qv_prof_cas(k1) - frac2 * qv_prof_cas(k2)
     1053          ql_mod_cas(l) = frac1 * ql_prof_cas(k1) - frac2 * ql_prof_cas(k2)
     1054          qi_mod_cas(l) = frac1 * qi_prof_cas(k1) - frac2 * qi_prof_cas(k2)
     1055          u_mod_cas(l) = frac1 * u_prof_cas(k1) - frac2 * u_prof_cas(k2)
     1056          v_mod_cas(l) = frac1 * v_prof_cas(k1) - frac2 * v_prof_cas(k2)
     1057          ug_mod_cas(l) = frac1 * ug_prof_cas(k1) - frac2 * ug_prof_cas(k2)
     1058          vg_mod_cas(l) = frac1 * vg_prof_cas(k1) - frac2 * vg_prof_cas(k2)
     1059          temp_nudg_mod_cas(l) = frac1 * temp_nudg_prof_cas(k1) - frac2 * temp_nudg_prof_cas(k2)
     1060          qv_nudg_mod_cas(l) = frac1 * qv_nudg_prof_cas(k1) - frac2 * qv_nudg_prof_cas(k2)
     1061          u_nudg_mod_cas(l) = frac1 * u_nudg_prof_cas(k1) - frac2 * u_nudg_prof_cas(k2)
     1062          v_nudg_mod_cas(l) = frac1 * v_nudg_prof_cas(k1) - frac2 * v_nudg_prof_cas(k2)
     1063
     1064          invtau_temp_nudg_mod_cas(l) = frac1 * invtau_temp_nudg_prof_cas(k1) - frac2 * invtau_temp_nudg_prof_cas(k2)
     1065          invtau_qv_nudg_mod_cas(l) = frac1 * invtau_qv_nudg_prof_cas(k1) - frac2 * invtau_qv_nudg_prof_cas(k2)
     1066          invtau_u_nudg_mod_cas(l) = frac1 * invtau_u_nudg_prof_cas(k1) - frac2 * invtau_u_nudg_prof_cas(k2)
     1067          invtau_v_nudg_mod_cas(l) = frac1 * invtau_v_nudg_prof_cas(k1) - frac2 * invtau_v_nudg_prof_cas(k2)
     1068
     1069          w_mod_cas(l) = frac1 * vitw_prof_cas(k1) - frac2 * vitw_prof_cas(k2)
     1070          omega_mod_cas(l) = frac1 * omega_prof_cas(k1) - frac2 * omega_prof_cas(k2)
     1071          du_mod_cas(l) = frac1 * du_prof_cas(k1) - frac2 * du_prof_cas(k2)
     1072          hu_mod_cas(l) = frac1 * hu_prof_cas(k1) - frac2 * hu_prof_cas(k2)
     1073          vu_mod_cas(l) = frac1 * vu_prof_cas(k1) - frac2 * vu_prof_cas(k2)
     1074          dv_mod_cas(l) = frac1 * dv_prof_cas(k1) - frac2 * dv_prof_cas(k2)
     1075          hv_mod_cas(l) = frac1 * hv_prof_cas(k1) - frac2 * hv_prof_cas(k2)
     1076          vv_mod_cas(l) = frac1 * vv_prof_cas(k1) - frac2 * vv_prof_cas(k2)
     1077          dt_mod_cas(l) = frac1 * dt_prof_cas(k1) - frac2 * dt_prof_cas(k2)
     1078          ht_mod_cas(l) = frac1 * ht_prof_cas(k1) - frac2 * ht_prof_cas(k2)
     1079          vt_mod_cas(l) = frac1 * vt_prof_cas(k1) - frac2 * vt_prof_cas(k2)
     1080          dth_mod_cas(l) = frac1 * dth_prof_cas(k1) - frac2 * dth_prof_cas(k2)
     1081          hth_mod_cas(l) = frac1 * hth_prof_cas(k1) - frac2 * hth_prof_cas(k2)
     1082          vth_mod_cas(l) = frac1 * vth_prof_cas(k1) - frac2 * vth_prof_cas(k2)
     1083          dq_mod_cas(l) = frac1 * dq_prof_cas(k1) - frac2 * dq_prof_cas(k2)
     1084          hq_mod_cas(l) = frac1 * hq_prof_cas(k1) - frac2 * hq_prof_cas(k2)
     1085          vq_mod_cas(l) = frac1 * vq_prof_cas(k1) - frac2 * vq_prof_cas(k2)
     1086          dtrad_mod_cas(l) = frac1 * dtrad_prof_cas(k1) - frac2 * dtrad_prof_cas(k2)
     1087
     1088        endif ! play.le.plev_prof_cas(1)
     1089
     1090      else ! above max altitude of forcing file
     1091
     1092        !jyg
     1093        fact = 20. * (plev_prof_cas(nlev_cas) - play(l)) / plev_prof_cas(nlev_cas) !jyg
     1094        fact = max(fact, 0.)                                           !jyg
     1095        fact = exp(-fact)                                             !jyg
     1096        t_mod_cas(l) = t_prof_cas(nlev_cas)                            !jyg
     1097        theta_mod_cas(l) = th_prof_cas(nlev_cas)                       !jyg
     1098        thv_mod_cas(l) = thv_prof_cas(nlev_cas)                        !jyg
     1099        thl_mod_cas(l) = thl_prof_cas(nlev_cas)                        !jyg
     1100        qv_mod_cas(l) = qv_prof_cas(nlev_cas) * fact                     !jyg
     1101        ql_mod_cas(l) = ql_prof_cas(nlev_cas) * fact                     !jyg
     1102        qi_mod_cas(l) = qi_prof_cas(nlev_cas) * fact                     !jyg
     1103        u_mod_cas(l) = u_prof_cas(nlev_cas) * fact                       !jyg
     1104        v_mod_cas(l) = v_prof_cas(nlev_cas) * fact                       !jyg
     1105        ug_mod_cas(l) = ug_prof_cas(nlev_cas)                          !jyg
     1106        vg_mod_cas(l) = vg_prof_cas(nlev_cas)                          !jyg
     1107        temp_nudg_mod_cas(l) = temp_nudg_prof_cas(nlev_cas)            !jyg
     1108        qv_nudg_mod_cas(l) = qv_nudg_prof_cas(nlev_cas)                !jyg
     1109        u_nudg_mod_cas(l) = u_nudg_prof_cas(nlev_cas)                  !jyg
     1110        v_nudg_mod_cas(l) = v_nudg_prof_cas(nlev_cas)                  !jyg
     1111
     1112        invtau_temp_nudg_mod_cas(l) = invtau_temp_nudg_prof_cas(nlev_cas)            !jyg
     1113        invtau_qv_nudg_mod_cas(l) = invtau_qv_nudg_prof_cas(nlev_cas)                !jyg
     1114        invtau_u_nudg_mod_cas(l) = invtau_u_nudg_prof_cas(nlev_cas)                  !jyg
     1115        invtau_v_nudg_mod_cas(l) = invtau_v_nudg_prof_cas(nlev_cas)                  !jyg
     1116
     1117        thv_mod_cas(l) = thv_prof_cas(nlev_cas)                        !jyg
     1118        w_mod_cas(l) = 0.0                                             !jyg
     1119        omega_mod_cas(l) = 0.0                                         !jyg
     1120        du_mod_cas(l) = du_prof_cas(nlev_cas) * fact
     1121        hu_mod_cas(l) = hu_prof_cas(nlev_cas) * fact                     !jyg
     1122        vu_mod_cas(l) = vu_prof_cas(nlev_cas) * fact                     !jyg
     1123        dv_mod_cas(l) = dv_prof_cas(nlev_cas) * fact
     1124        hv_mod_cas(l) = hv_prof_cas(nlev_cas) * fact                     !jyg
     1125        vv_mod_cas(l) = vv_prof_cas(nlev_cas) * fact                     !jyg
     1126        dt_mod_cas(l) = dt_prof_cas(nlev_cas)
     1127        ht_mod_cas(l) = ht_prof_cas(nlev_cas)                          !jyg
     1128        vt_mod_cas(l) = vt_prof_cas(nlev_cas)                          !jyg
     1129        dth_mod_cas(l) = dth_prof_cas(nlev_cas)
     1130        hth_mod_cas(l) = hth_prof_cas(nlev_cas)                        !jyg
     1131        vth_mod_cas(l) = vth_prof_cas(nlev_cas)                        !jyg
     1132        dq_mod_cas(l) = dq_prof_cas(nlev_cas) * fact
     1133        hq_mod_cas(l) = hq_prof_cas(nlev_cas) * fact                     !jyg
     1134        vq_mod_cas(l) = vq_prof_cas(nlev_cas) * fact                     !jyg
     1135        dtrad_mod_cas(l) = dtrad_prof_cas(nlev_cas) * fact               !jyg
     1136
     1137      endif ! play
    11551138
    11561139    enddo ! l
    … …  
    11581141    ! for variables defined at layer interfaces (EV):
    11591142
    1160 
    1161     do l = 1, llm+1
    1162 
    1163        IF (plev(l)>=plev_prof_cas(nlev_cas)) THEN
    1164           mxcalc=l
    1165           k1=0
    1166           k2=0
    1167 
    1168           IF (plev(l)<=plev_prof_cas(1)) THEN
    1169              do k = 1, nlev_cas-1
    1170                 IF (plev(l)<=plev_prof_cas(k).AND. plev(l)>plev_prof_cas(k+1)) THEN
    1171                    k1=k
    1172                    k2=k+1
    1173                 endif
    1174              enddo
    1175 
    1176              IF (k1==0 .OR. k2==0) THEN
    1177                 WRITE(*,*) 'PB! k1, k2 = ',k1,k2
    1178                 WRITE(*,*) 'l,plev(l) = ',l,plev(l)/100
    1179                 do k = 1, nlev_cas-1
    1180                    WRITE(*,*) 'k,plev_prof_cas(k) = ',k,plev_prof_cas(k)/100
    1181                 enddo
    1182              endif
    1183 
    1184              frac = (plev_prof_cas(k2)-plev(l))/(plev_prof_cas(k2)-plev_prof_cas(k1))
    1185              tke_mod_cas(l)= tke_prof_cas(k2) - frac*(tke_prof_cas(k2)-tke_prof_cas(k1))
    1186           else !play>plev_prof_cas(1)
    1187              k1=1
    1188              k2=2
    1189              frac1 = (play(l)-plev_prof_cas(k2))/(plev_prof_cas(k1)-plev_prof_cas(k2))
    1190              frac2 = (play(l)-plev_prof_cas(k1))/(plev_prof_cas(k1)-plev_prof_cas(k2))
    1191              tke_mod_cas(l)= frac1*tke_prof_cas(k1) - frac2*tke_prof_cas(k2)
    1192 
    1193           endif ! plev.le.plev_prof_cas(1)
    1194 
    1195        else ! above max altitude of forcing file
    1196 
    1197           tke_mod_cas(l)=0.0
    1198 
    1199        endif ! plev
     1143    do l = 1, llm + 1
     1144
     1145      IF (plev(l)>=plev_prof_cas(nlev_cas)) THEN
     1146        mxcalc = l
     1147        k1 = 0
     1148        k2 = 0
     1149
     1150        IF (plev(l)<=plev_prof_cas(1)) THEN
     1151          do k = 1, nlev_cas - 1
     1152            IF (plev(l)<=plev_prof_cas(k).AND. plev(l)>plev_prof_cas(k + 1)) THEN
     1153              k1 = k
     1154              k2 = k + 1
     1155            endif
     1156          enddo
     1157
     1158          IF (k1==0 .OR. k2==0) THEN
     1159            WRITE(*, *) 'PB! k1, k2 = ', k1, k2
     1160            WRITE(*, *) 'l,plev(l) = ', l, plev(l) / 100
     1161            do k = 1, nlev_cas - 1
     1162              WRITE(*, *) 'k,plev_prof_cas(k) = ', k, plev_prof_cas(k) / 100
     1163            enddo
     1164          endif
     1165
     1166          frac = (plev_prof_cas(k2) - plev(l)) / (plev_prof_cas(k2) - plev_prof_cas(k1))
     1167          tke_mod_cas(l) = tke_prof_cas(k2) - frac * (tke_prof_cas(k2) - tke_prof_cas(k1))
     1168        else !play>plev_prof_cas(1)
     1169          k1 = 1
     1170          k2 = 2
     1171          frac1 = (play(l) - plev_prof_cas(k2)) / (plev_prof_cas(k1) - plev_prof_cas(k2))
     1172          frac2 = (play(l) - plev_prof_cas(k1)) / (plev_prof_cas(k1) - plev_prof_cas(k2))
     1173          tke_mod_cas(l) = frac1 * tke_prof_cas(k1) - frac2 * tke_prof_cas(k2)
     1174
     1175        endif ! plev.le.plev_prof_cas(1)
     1176
     1177      else ! above max altitude of forcing file
     1178
     1179        tke_mod_cas(l) = 0.0
     1180
     1181      endif ! plev
    12001182
    12011183    enddo ! l
    12021184
    1203 
    1204 
    1205 
    12061185  END SUBROUTINE  interp2_case_vertical_std
    1207   !*****************************************************************************
    1208 
    1209 
    1210 
     1186  !*****************************************************************************
    12111187
    12121188

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

    r5135 r5144  
    23722372            nf90_inq_dimid,nf90_inquire_dimension
    23732373
     2374            USE lmdz_yomcst
     2375
    23742376      IMPLICIT NONE
    23752377
    2376       INCLUDE "YOMCST.h"
    23772378
    23782379      INTEGER ntime,nlevel
    … …  
    29452946
    29462947      SUBROUTINE read_circ(nlev_circ,cf,lwp,iwp,reliq,reice,t,z,p,pm,h2o,o3,sza)
     2948
     2949      USE lmdz_yomcst
    29472950     
    29482951      parameter (ncm_1=49180)
    2949       INCLUDE "YOMCST.h"
    29502952
    29512953      REAL albsfc(ncm_1), albsfc_w(ncm_1)
    … …  
    30513053      SUBROUTINE read_rtmip(nlev_rtmip,play,plev,t,h2o,o3)
    30523054     
    3053       INCLUDE "YOMCST.h"
     3055      USE lmdz_yomcst
    30543056
    30553057      REAL t(nlev_rtmip), pt(nlev_rtmip),pb(nlev_rtmip),h2o(nlev_rtmip), o3(nlev_rtmip)
Note: See TracChangeset for help on using the changeset viewer.