Ignore:
Timestamp:
Jul 22, 2024, 9:29:09 PM (11 months ago)
Author:
abarral
Message:

Replace most uses of CPP_DUST by the corresponding logical defined in lmdz_cppkeys_wrapper.F90
Convert several files from .F to .f90 to allow Dust to compile w/o rrtm/ecrad
Create lmdz_yoerad.f90
(lint) Remove "!" on otherwise empty line

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

Legend:

Unmodified
Added
Removed

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

    r5088 r5099  
    11#include "conf_gcm.F90"
    22
    3 !
    43! $Id$
    5 !
    6 !
    7 !
     4
     5
     6
    87      SUBROUTINE conf_unicol
    9 !
     8
    109#ifdef CPP_IOIPSL
    1110      use IOIPSL
    … …  
    1817!-----------------------------------------------------------------------
    1918!     Auteurs :   A. Lahellec  .
    20 !
     19
    2120!   Declarations :
    2221!   --------------
    … …  
    2726#include "fcg_gcssold.h"
    2827#include "fcg_racmo.h"
    29 !
    30 !
     28
     29
    3130!   local:
    3231!   ------
    3332
    3433!      CHARACTER ch1*72,ch2*72,ch3*72,ch4*12
    35      
    36 !
     34
    3735!  -------------------------------------------------------------------
    38 !
     36
    3937!      .........    Initilisation parametres du lmdz1D      ..........
    40 !
     38
    4139!---------------------------------------------------------------------
    4240!   initialisations:
    … …  
    120118!         > 100 ==> forcing_case = .true. or forcing_case2 = .true.
    121119!             initial profiles from case.nc file
    122 !
     120
    123121       forcing_type = 0
    124122       CALL getin('forcing_type',forcing_type)
    … …  
    652650      write(lunout,*)' +++++++++++++++++++++++++++++++++++++++'
    653651      write(lunout,*)
    654 !
     652
    655653      RETURN
    656654      END
    657 !
     655
    658656! $Id: dyn1deta0.F 1279 2010/07/30 A Lahellec$
    659 !
    660 !
     657
     658
    661659      SUBROUTINE dyn1deta0(fichnom,plev,play,phi,phis,presnivs,                 &
    662660     &                          ucov,vcov,temp,q,omega2)
    … …  
    719717      print*,'after open startphy ',fichnom,nmq
    720718
    721 !
    722719! Lecture des parametres de controle:
    723 !
     720
    724721      CALL get_var("controle",tab_cntrl)
    725722       
    … …  
    744741!      pa         = tab_cntrl(18)
    745742!      preff      = tab_cntrl(19)
    746 !
     743
    747744!      clon       = tab_cntrl(20)
    748745!      clat       = tab_cntrl(21)
    749746!      grossismx  = tab_cntrl(22)
    750747!      grossismy  = tab_cntrl(23)
    751 !
     748
    752749      IF ( tab_cntrl(24).EQ.1. )  THEN
    753750        fxyhypb  =.true.
    … …  
    765762      itau_dyn = tab_cntrl(31)
    766763!   .................................................................
    767 !
    768 !
     764
     765
    769766!      PRINT*,'rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa
    770767!Al1
    … …  
    773770
    774771!  Lecture des champs
    775 !
     772
    776773      CALL get_field("play",play,found)
    777774      IF (.NOT. found) PRINT*, modname//'Le champ <Play> est absent'
    … …  
    801798      CALL close_startphy
    802799      print*,' close startphy',fichnom,play(1,1),play(1,klev),temp(1,klev)
    803 !
     800
    804801      RETURN
    805802      END
    806 !
     803
    807804! $Id: dyn1dredem.F 1279 2010/07/29 A Lahellec$
    808 !
    809 !
     805
     806
    810807      SUBROUTINE dyn1dredem(fichnom,plev,play,phi,phis,presnivs,           &
    811808     &                          ucov,vcov,temp,q,omega2)
    … …  
    854851      character*20 modname
    855852      character*80 abort_message
    856 !
     853
    857854      INTEGER pass
    858855
    … …  
    896893!       tab_cntrl(18) = pa
    897894!       tab_cntrl(19) = preff
    898 !
     895
    899896!    .....    parametres  pour le zoom      ......   
    900897
    … …  
    903900!       tab_cntrl(22)  = grossismx
    904901!       tab_cntrl(23)  = grossismy
    905 !
     902
    906903      IF ( fxyhypb )   THEN
    907904       tab_cntrl(24) = 1.
    … …  
    923920       tab_cntrl(30) = FLOAT(day_end)
    924921       tab_cntrl(31) = FLOAT(itau_dyn + itaufin)
    925 !
     922
    926923      DO pass=1,2
    927924      CALL put_var(pass,"controle","Param. de controle Dyn1D",tab_cntrl)
    928 !
    929925
    930926!  Ecriture/extension de la coordonnee temps
    … …  
    932928
    933929!  Ecriture des champs
    934 !
     930
    935931      CALL put_field(pass,"plev","p interfaces sauf la nulle",plev)
    936932      CALL put_field(pass,"play","",play)
    … …  
    953949      ENDDO
    954950
    955 !
    956951      RETURN
    957952      END
    … …  
    999994 
    1000995      USE IOIPSL
    1001 !
     996
    1002997! Stops the simulation cleanly, closing files and printing various
    1003998! comments
    1004 !
     999
    10051000!  Input: modname = name of calling program
    10061001!         message = stuff to print
    … …  
    10211016      write(*,*) 'Reason = ',message
    10221017      call getin_dump
    1023 !
     1018
    10241019      if (ierr .eq. 0) then
    10251020        write(*,*) 'Everything is cool'
    … …  
    10301025      END
    10311026      REAL FUNCTION fq_sat(kelvin, millibar)
    1032 !
     1027
    10331028      IMPLICIT none
    10341029!======================================================================
    … …  
    10391034! kelvin---input-R: temperature en Kelvin
    10401035! millibar--input-R: pression en mb
    1041 !
     1036
    10421037! fq_sat----output-R: vapeur d'eau saturante en kg/kg
    10431038!======================================================================
    1044 !
     1039
    10451040      REAL kelvin, millibar
    1046 !
     1041
    10471042      REAL r2es
    10481043      PARAMETER (r2es=611.14 *18.0153/28.9644)
    1049 !
     1044
    10501045      REAL r3les, r3ies, r3es
    10511046      PARAMETER (R3LES=17.269)
    10521047      PARAMETER (R3IES=21.875)
    1053 !
     1048
    10541049      REAL r4les, r4ies, r4es
    10551050      PARAMETER (R4LES=35.86)
    10561051      PARAMETER (R4IES=7.66)
    1057 !
     1052
    10581053      REAL rtt
    10591054      PARAMETER (rtt=273.16)
    1060 !
     1055
    10611056      REAL retv
    10621057      PARAMETER (retv=28.9644/18.0153 - 1.0)
    1063 !
     1058
    10641059      REAL zqsat
    10651060      REAL temp, pres
    10661061!     ------------------------------------------------------------------
    1067 !
    1068 !
     1062
     1063
    10691064      temp = kelvin
    10701065      pres = millibar * 100.0
    10711066!      write(*,*)'kelvin,millibar=',kelvin,millibar
    10721067!      write(*,*)'temp,pres=',temp,pres
    1073 !
     1068
    10741069      IF (temp .LE. rtt) THEN
    10751070         r3es = r3ies
    … …  
    10791074         r4es = r4les
    10801075      ENDIF
    1081 !
     1076
    10821077      zqsat=r2es/pres * EXP ( r3es*(temp-rtt) / (temp-r4es) )
    10831078      zqsat=MIN(0.5,ZQSAT)
    10841079      zqsat=zqsat/(1.-retv  *zqsat)
    1085 !
     1080
    10861081      fq_sat = zqsat
    1087 !
     1082
    10881083      RETURN
    10891084      END
    … …  
    11311126!    le disvert de dyn3d (qui permet d'utiliser grille avec ab,bp imposes)
    11321127!    (MPL 18092012)
    1133 !
     1128
    11341129!    Auteur :  P. Le Van .
    1135 !
     1130
    11361131      IMPLICIT NONE
    11371132 
    11381133      include "dimensions.h"
    11391134      include "paramet.h"
    1140 !
     1135
    11411136!=======================================================================
    1142 !
    1143 !
     1137
     1138
    11441139!    s = sigma ** kappa   :  coordonnee  verticale
    11451140!    dsig(l)            : epaisseur de la couche l ds la coord.  s
    11461141!    sig(l)             : sigma a l'interface des couches l et l-1
    11471142!    ds(l)              : distance entre les couches l et l-1 en coord.s
    1148 !
     1143
    11491144!=======================================================================
    1150 !
     1145
    11511146      REAL pa,preff
    11521147      REAL ap(llmp1),bp(llmp1),dpres(llm),nivsigs(llm),nivsig(llmp1)
    11531148      REAL presnivs(llm)
    1154 !
     1149
    11551150!   declarations:
    11561151!   -------------
    1157 !
     1152
    11581153      REAL sig(llm+1),dsig(llm)
    1159 !
     1154
    11601155      INTEGER l
    11611156      REAL snorm
    … …  
    11651160 
    11661161!-----------------------------------------------------------------------
    1167 !
     1162
    11681163      pi=2.*ASIN(1.)
    11691164 
    … …  
    11861181      CLOSE(99)
    11871182      alpha=deltaz/(llm*h)
    1188 !
    1189  
     1183
    11901184       DO 1  l = 1, llm
    11911185       dsig(l) = (alpha+(1.-alpha)*exp(-beta*(llm-l)))*                    &
    … …  
    12031197       dsig(l) = sig(l)-sig(l+1)
    12041198   2   CONTINUE
    1205 !
    1206  
     1199
    12071200      ELSE
    12081201!-----------------------------------------------------------------------
    … …  
    12381231        nivsig(l)= FLOAT(l)
    12391232      ENDDO
    1240  
    1241 !
     1233
    12421234!    ....  Calculs  de ap(l) et de bp(l)  ....
    12431235!    .........................................
    1244 !
    1245 !
     1236
    12461237!   .....  pa et preff sont lus  sur les fichiers start par lectba  .....
    1247 !
    1248  
     1238
    12491239      bp(llmp1) =   0.
    12501240 
    … …  
    12561246      bp(l) = EXP( 1. -1./( sig(l)*sig(l)) )
    12571247      ap(l) = pa * ( sig(l) - bp(l) )
    1258 !
     1248
    12591249      ENDDO
    12601250      ap(llmp1) = pa * ( sig(llmp1) - bp(llmp1) )
    … …  
    12781268!!======================================================================
    12791269!       SUBROUTINE read_tsurf1d(knon,sst_out)
    1280 !
     1270
    12811271!! This subroutine specifies the surface temperature to be used in 1D simulations
    1282 !
     1272
    12831273!      USE dimphy, ONLY : klon
    1284 !
     1274
    12851275!      INTEGER, INTENT(IN)                  :: knon     ! nomber of points on compressed grid
    12861276!      REAL, DIMENSION(klon), INTENT(OUT)   :: sst_out  ! tsurf used to force the single-column model
    1287 !
     1277
    12881278!       INTEGER :: i
    12891279!! COMMON defined in lmdz1d.F:
    … …  
    12941284!        sst_out(i) = ts_cur
    12951285!       ENDDO
    1296 !
     1286
    12971287!      END SUBROUTINE read_tsurf1d
    1298 !
     1288
    12991289!===============================================================
    13001290      subroutine advect_vert(llm,w,dt,q,plev)
    … …  
    15131503      REAL paprs(klon,klevp1)
    15141504      REAL pplay(klon,klev)
    1515 !
     1505
    15161506!      Variables d'etat
    15171507      REAL t(klon,klev)
    15181508      REAL q(klon,klev)
    1519 !
     1509
    15201510!   Profiles cible
    15211511      REAL t_targ(klon,klev)
    15221512      REAL rh_targ(klon,klev)
    1523 !
     1513
    15241514   INTEGER k,i
    15251515   REAL zx_qs
    15261516
    15271517! Declaration des constantes et des fonctions thermodynamiques
    1528 !
     1518
    15291519include "YOMCST.h"
    15301520include "YOETHF.h"
    1531 !
     1521
    15321522!  ----------------------------------------
    15331523!  Statement functions
    15341524include "FCTTRE.h"
    15351525!  ----------------------------------------
    1536 !
     1526
    15371527        DO k = 1,klev
    15381528         DO i = 1,klon
    … …  
    15481538      print *, 't_targ',t_targ
    15491539      print *, 'rh_targ',rh_targ
    1550 !
    1551 !
     1540
     1541
    15521542      RETURN
    15531543      END
    … …  
    15621552      REAL paprs(klon,klevp1)
    15631553      REAL pplay(klon,klev)
    1564 !
     1554
    15651555!      Variables d'etat
    15661556      REAL u(klon,klev)
    15671557      REAL v(klon,klev)
    1568 !
     1558
    15691559!   Profiles cible
    15701560      REAL u_targ(klon,klev)
    15711561      REAL v_targ(klon,klev)
    1572 !
     1562
    15731563   INTEGER k,i
    1574 !
     1564
    15751565        DO k = 1,klev
    15761566         DO i = 1,klon
    … …  
    15811571      print *, 'u_targ',u_targ
    15821572      print *, 'v_targ',v_targ
    1583 !
    1584 !
     1573
     1574
    15851575      RETURN
    15861576      END
    … …  
    15971587      REAL paprs(klon,klevp1)
    15981588      REAL pplay(klon,klev)
    1599 !
     1589
    16001590!      Variables d'etat
    16011591      REAL t(klon,klev)
    16021592      REAL q(klon,klev)
    1603 !
     1593
    16041594! Tendances
    16051595      REAL d_t(klon,klev)
    16061596      REAL d_q(klon,klev)
    1607 !
     1597
    16081598!   Profiles cible
    16091599      REAL t_targ(klon,klev)
    16101600      REAL rh_targ(klon,klev)
    1611 !
     1601
    16121602!   Temps de relaxation
    16131603      REAL tau
    … …  
    16151605!!      DATA tau /5400./
    16161606      DATA tau /1800./
    1617 !
     1607
    16181608   INTEGER k,i
    16191609   REAL zx_qs, rh, tnew, d_rh, rhnew
    16201610
    16211611! Declaration des constantes et des fonctions thermodynamiques
    1622 !
     1612
    16231613include "YOMCST.h"
    16241614include "YOETHF.h"
    1625 !
     1615
    16261616!  ----------------------------------------
    16271617!  Statement functions
    16281618include "FCTTRE.h"
    16291619!  ----------------------------------------
    1630 !
     1620
    16311621        print *,'dtime, tau ',dtime,tau
    16321622        print *, 't_targ',t_targ
    … …  
    16341624        print *,'temp ',t
    16351625        print *,'hum ',q
    1636 !
     1626
    16371627        DO k = 1,klev
    16381628         DO i = 1,klon
    … …  
    16441634            ENDIF
    16451635            rh = q(i,k)/zx_qs
    1646 !
     1636
    16471637            d_t(i,k) = d_t(i,k) + 1./tau*(t_targ(i,k)-t(i,k))
    16481638            d_rh = 1./tau*(rh_targ(i,k)-rh)
    1649 !
     1639
    16501640            tnew = t(i,k)+d_t(i,k)*dtime
    16511641!jyg<
    16521642!   Formule pour q :
    16531643!                         d_q = (1/tau) [rh_targ*qsat(T_new) - q]
    1654 !
     1644
    16551645!  Cette formule remplace d_q = (1/tau) [rh_targ - rh] qsat(T_new)
    16561646!   qui n'etait pas correcte.
    1657 !
     1647
    16581648            IF (tnew.LT.RTT) THEN
    16591649               zx_qs = qsats(tnew)/(pplay(i,k))
    … …  
    16641654            d_q(i,k) = d_q(i,k) + (1./tau)*(rh_targ(i,k)*zx_qs - q(i,k))
    16651655            rhnew = (q(i,k)+d_q(i,k)*dtime)/zx_qs
    1666 !
     1656
    16671657            print *,' k,d_t,rh,d_rh,rhnew,d_q ',    &
    16681658                      k,d_t(i,k),rh,d_rh,rhnew,d_q(i,k)
    16691659           ENDIF
    1670 !
     1660
    16711661         ENDDO
    16721662        ENDDO
    1673 !
     1663
    16741664      RETURN
    16751665      END
    … …  
    16861676      REAL paprs(klon,klevp1)
    16871677      REAL pplay(klon,klev)
    1688 !
     1678
    16891679!      Variables d'etat
    16901680      REAL u(klon,klev)
    16911681      REAL v(klon,klev)
    1692 !
     1682
    16931683! Tendances
    16941684      REAL d_u(klon,klev)
    16951685      REAL d_v(klon,klev)
    1696 !
     1686
    16971687!   Profiles cible
    16981688      REAL u_targ(klon,klev)
    16991689      REAL v_targ(klon,klev)
    1700 !
     1690
    17011691!   Temps de relaxation
    17021692      REAL tau
    … …  
    17041694!      DATA tau /5400./
    17051695       DATA tau /43200./
    1706 !
     1696
    17071697   INTEGER k,i
    17081698
    1709 !
    17101699        !print *,'dtime, tau ',dtime,tau
    17111700        !print *, 'u_targ',u_targ
    … …  
    17171706!CR: nudging everywhere
    17181707!           IF (paprs(i,1)-pplay(i,k) .GT. 10000.) THEN
    1719 !
     1708
    17201709            d_u(i,k) = d_u(i,k) + 1./tau*(u_targ(i,k)-u(i,k))
    17211710            d_v(i,k) = d_v(i,k) + 1./tau*(v_targ(i,k)-v(i,k))
    1722 !
     1711
    17231712!           print *,' k,u,d_u,v,d_v ',    &
    17241713!                     k,u(i,k),d_u(i,k),v(i,k),d_v(i,k)
    17251714!           ENDIF
    1726 !
     1715
    17271716         ENDDO
    17281717        ENDDO
    1729 !
     1718
    17301719      RETURN
    17311720      END
    … …  
    17391728     &         ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas &
    17401729     &         ,dth_prof_cas,hth_prof_cas,vth_prof_cas                                                 &
    1741 !
     1730
    17421731     &         ,t_mod_cas,theta_mod_cas,thv_mod_cas,thl_mod_cas                                        &
    17431732     &         ,qv_mod_cas,ql_mod_cas,qi_mod_cas,u_mod_cas,v_mod_cas                                   &

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

    r5075 r5099  
    109109!       real dt_gabls4
    110110!       parameter (dt_gabls4=3600.) ! 1 forcage ttes les heures
    111 !
     111
    112112!profils initiaux:
    113113!       real plev_gabls4(nlev_gabls4)
    … …  
    119119!       real u_gabi(nlev_gabls4), v_gabi(nlev_gabls4),ug_gabi(nlev_gabls4), vg_gabi(nlev_gabls4)
    120120!       real ht_gabi(nlev_gabls4),hq_gabi(nlev_gabls4),poub(nlev_gabls4)
    121 !       
     121
    122122!forcings
    123123! Lignes a detruire ...
    … …  
    128128!       real ug_profg(nlev_gabls4),vg_profg(nlev_gabls4)
    129129!       real tg_profg
    130 !       
     130
    131131!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    132132

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

    r4297 r5099  
    1818     &       ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,lat_cas,sens_cas,ustar_cas       &
    1919     &       ,uw_cas,vw_cas,q1_cas,q2_cas,tkes_cas                                           &
    20 !
     20
    2121     &       ,ts_prof_cas,tskin_prof_cas,ps_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas,thv_prof_cas  &
    2222     &       ,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas                              &
    … …  
    5151     &         ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas    &
    5252     &         ,dth_prof_cas,hth_prof_cas,vth_prof_cas                                                    &
    53 !
     53
    5454     &         ,t_mod_cas,theta_mod_cas,thv_mod_cas,thl_mod_cas,qv_mod_cas,ql_mod_cas,qi_mod_cas          &
    5555     &         ,u_mod_cas,v_mod_cas,ug_mod_cas,vg_mod_cas                                                 &
    … …  
    183183       print *,'1D_interp: sens,flat',fsens,flat
    184184      ENDIF
    185 !
     185
    186186      IF (ok_prescr_ust) THEN
    187187       ust=ustar_prof_cas

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

    r4142 r5099  
    11      do l = 1, llm
    2 !
     2
    33! au dessus de 700hPa, on relaxe vers profil init
    44!      on fait l'hypothese que dans ce cas, il n'y a plus d'eau liq. au dessus 700hpa
    … …  
    1010       relax_thl(l)=0.
    1111!      print *,'nudge: l tau_sandu u u_mod',l,tau_sandu,u(l),u_mod(l)
    12 !
     12
    1313       if (l.ge.llm700) then
    1414         relax_q(l,1)=(q(l,1)-q_mod(l))/tau_sandu

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

    r4650 r5099  
    1 !
     1
    22! $Id$
    3 !
     3
    44!----------------------------------------------------------------------
    55! forcing_les = .T. : Impose a constant cooling
    … …  
    3232     &       ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,lat_cas,sens_cas,ustar_cas       &
    3333     &       ,uw_cas,vw_cas,q1_cas,q2_cas,tkes_cas                                           &
    34 !
     34
    3535     &       ,ts_prof_cas,tskin_prof_cas,ps_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas,thv_prof_cas  &
    3636     &       ,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas                              &
    … …  
    6161     &         ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas    &
    6262     &         ,dth_prof_cas,hth_prof_cas,vth_prof_cas                                                    &
    63 !
     63
    6464     &         ,t_mod_cas,theta_mod_cas,thv_mod_cas,thl_mod_cas,qv_mod_cas,ql_mod_cas,qi_mod_cas          &
    6565     &         ,u_mod_cas,v_mod_cas,ug_mod_cas,vg_mod_cas                                                 &
    … …  
    129129       flat=-1.*lat_prof_cas
    130130       ENDIF
    131 !
     131
    132132       IF (ok_prescr_ust) THEN
    133133       ust=ustar_prof_cas

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

    r4593 r5099  
    1 !
     1
    22! $Id$
    3 !
     3
    44        subroutine get_uvd(itap,dtime,file_forctl,file_fordat,                  &
    55     &       ht,hq,hw,hu,hv,hthturb,hqturb,                                     &
    66     &       Ts,imp_fcg,ts_fcg,Tp_fcg,Turb_fcg)                                 
    7 !
     7
    88        implicit none
    99 
    … …  
    109109        real Tsbef
    110110        save htbef,hqbef,hwbef,hubef,hvbef,hthturbbef,hqturbbef
    111 !
     111
    112112        real timeaft,timebef
    113113        save timeaft,timebef
    … …  
    131131        real hqturb_mes(100) !tendance horizontale d humidite, due aux
    132132                              !flux turbulents
    133 !
     133
    134134!---------------------------------------------------------------------
    135135! variable argument de la subroutine copie
    … …  
    149149!*** on determine le pas du meso_NH correspondant au nouvel itap ***
    150150!*** pour aller chercher les champs dans rdgrads                 ***
    151 !
     151
    152152        time=time0+itap*dtime
    153153!c        temps=int(time/dt+1)
    … …  
    156156        pas=min(temps,pasmax-1)
    157157             print*,'le pas Meso est:',pas
    158 !
    159 !
     158
     159
    160160!===================================================================
    161 !
     161
    162162!*** on remplit les champs before avec les champs after du pas   ***
    163163!*** precedent en format gcm                                     ***
    … …  
    190190     &                  ,hu_mes,hv_mes,hthturb_mes,hqturb_mes                 &
    191191     &                  ,ts_fcg,ts_subr,imp_fcg,Turb_fcg)
    192 !
    193192
    194193               if(Tp_fcg) then
    … …  
    203202         enddo
    204203        endif  ! Turb_fcg
    205 !
     204
    206205               print*,'ht_mes ',(ht_mes(i),i=1,nblvlm)
    207206               print*,'hq_mes ',(hq_mes(i),i=1,nblvlm)
    … …  
    286285         ts_subr = ((timeaft-time)*tsbef + (time-timebef)*tsaft)/dt
    287286       endif ! temps.ge.pasmax
    288 !
     287
    289288        print *,' time,timebef,timeaft',time,timebef,timeaft
    290289        print *,' ht,htbef,htaft,hthturb,hthturbbef,hthturbaft'
    … …  
    298297     &             hqturb(j),hqturbbef(j),hqturbaft(j)
    299298        enddo
    300 !
     299
    301300!-------------------------------------------------------------------
    302 !
     301
    303302         IF (Ts_fcg) Ts = Ts_subr
    304303         return
    305 !
     304
    306305!-----------------------------------------------------------------------
    307306! on sort les champs de "convergence" pour l instant initial 'in'
    … …  
    312311     &           imp_fcg,ts_fcg,Tp_fcg,Turb_fcg)
    313312             print*,'le pas itap est:',itap
    314 !
     313
    315314!===================================================================
    316 !
     315
    317316       write(*,'(a)') 'OPEN '//file_forctl
    318317       open(97,FILE=file_forctl,FORM='FORMATTED')
    319 !
     318
    320319!------------------
    321320      do i=1,1000
    … …  
    355354                  pasprev=in-1
    356355                  time0=dt*pasprev
    357 !
     356
    358357          close(98)
    359 !
     358
    360359      write(*,'(a)') 'OPEN '//file_fordat
    361360      open(99,FILE=file_fordat,FORM='UNFORMATTED',                          &
    … …  
    371370          print *, 'get_uvd : rdgrads ->'
    372371          print *, tp_fcg
    373 !
     372
    374373! following commented out because we have temperature already in ARM case
    375374!   (otherwise this is the potential temperature )
    … …  
    445444          close(99)
    446445          close(98)
    447 !
     446
    448447!-------------------------------------------------------------------
    449 !
    450 !
     448
     449
    451450 100      IF (Ts_fcg) Ts = Ts_subr
    452451        return
    453 !
     452
    454453999     continue
    455454        stop 'erreur lecture, file forcing.ctl'
    … …  
    565564      SUBROUTINE mesolupbis(file_forctl)
    566565      implicit none
    567 !
     566
    568567!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
    569 !
     568
    570569! Lecture descripteur des donnees MESO-NH (forcing.ctl):
    571570! -------------------------------------------------------
    572 !
     571
    573572!     Cette subroutine lit dans le fichier de controle "essai.ctl"
    574573!     et affiche le nombre de niveaux du Meso-NH ainsi que les valeurs
    575574!     des pressions en milieu de couche du Meso-NH (en Pa puis en hPa).
    576575!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
    577 !
     576
    578577      INTEGER nblvlm !nombre de niveau de pression du mesoNH
    579578      REAL playm(100)  !pression en Pa milieu de chaque couche Meso-NH
    … …  
    591590      lu=9
    592591      open(lu,file=file_forctl,form='formatted')
    593 !
     592
    594593      do i=1,1000
    595594      read(lu,1000,end=999) a
    596595      if (a .eq. 'ZDEF') go to 100
    597596      enddo
    598 !
     597
    599598 100  backspace(lu)
    600599      print*,'  DESCRIPTION DES 2 MODELES : '
    601600      print*,' '
    602 !
     601
    603602      read(lu,2000) aaa
    604603 2000  format (a80)
    … …  
    607606         read(anblvl,*) nblvlm
    608607
    609 !
    610608      print*,'nbre de niveaux de pression Meso-NH :',nblvlm
    611609      print*,' '
    612610      print*,'pression en Pa de chaque couche du meso-NH :'
    613 !
     611
    614612      read(lu,*) (playm(mlz),mlz=1,nblvlm)
    615613!      Si la pression est en HPa, la multiplier par 100
    … …  
    620618      endif
    621619      print*,(playm(mlz),mlz=1,nblvlm)
    622 !
     620
    623621 1000 format (a4)
    624622 1001 format(5x,i2)
    625 !
     623
    626624      print*,' '
    627625      do mlzh=1,nblvlm
    628626      hplaym(mlzh)=playm(mlzh)/100.
    629627      enddo
    630 !
     628
    631629      print*,'pression en hPa de chaque couche du meso-NH: '
    632630      print*,(hplaym(mlzh),mlzh=1,nblvlm)
    633 !
     631
    634632      close (lu)
    635633      return
    636 !
     634
    637635 999  stop 'erreur lecture des niveaux pression des donnees'
    638636      end
    … …  
    645643      real hthtur(nl),hqtur(nl)
    646644      real ts
    647 !
     645
    648646      INTEGER k
    649 !
     647
    650648      LOGICAL imp_fcg,ts_fcg,Turb_fcg
    651 !
     649
    652650      icomp = icount
    653 !
    654 !
     651
     652
    655653         do k=1,nl
    656654            icomp=icomp+1
    … …  
    667665            read(itape,rec=icomp)hQ(k)
    668666         enddo
    669 !
     667
    670668             if(turb_fcg) then
    671669         do k=1,nl
    … …  
    679677             endif
    680678         print *,' apres lecture hthtur, hqtur'
    681 !
     679
    682680          if(imp_fcg) then
    683681
    … …  
    692690
    693691          endif
    694 !
     692
    695693         do k=1,nl
    696694            icomp=icomp+1
    697695            read(itape,rec=icomp)hw(k)
    698696         enddo
    699 !
     697
    700698              if(ts_fcg) then
    701699         icomp=icomp+1
    702700         read(itape,rec=icomp)ts
    703701              endif
    704 !
     702
    705703      print *,' rdgrads ->'
    706704
    … …  
    756754       endif
    757755      enddo
    758 !
     756
    759757!c      if (play(klev) .le. playm(nblvlm)) then
    760758!c         mlz=nblvlm-1
    … …  
    765763!c     *            /(playm(mlz+1)-playm(mlz))
    766764!c      endif
    767 !
     765
    768766      print*,' '
    769767      print*,'         INTERPOLATION  : '
    … …  
    779777      print*,'valeurs du deuxieme coef d"interpolation pour les 9 niveaux:'
    780778      print*,(coef2(k),k=1,klev)
    781 !
     779
    782780      return
    783781      end
    … …  
    821819      END
    822820      CHARACTER*(*) FUNCTION SPACES(STR,NSPACE)
    823 !
     821
    824822! CERN PROGLIB# M433    SPACES          .VERSION KERNFOR  4.14  860211
    825823! ORIG.  6/05/86 M.GOOSSENS/DD
    826 !
     824
    827825!-    The function value SPACES returns the character string STR with
    828826!-    leading blanks removed and each occurence of one or more blanks
    829827!-    replaced by NSPACE blanks inside the string STR
    830 !
     828
    831829      CHARACTER*(*) STR
    832 !
     830
    833831      LENSPA = LEN(SPACES)
    834832      SPACES = ' '
    … …  
    853851  999 END
    854852      FUNCTION INDEXC(STR,SSTR)
    855 !
     853
    856854! CERN PROGLIB# M433    INDEXC          .VERSION KERNFOR  4.14  860211
    857855! ORIG. 26/03/86 M.GOOSSENS/DD
    858 !
     856
    859857!-    Find the leftmost position where substring SSTR does not match
    860858!-    string STR scanning forward
    861 !
     859
    862860      CHARACTER*(*) STR,SSTR
    863 !
     861
    864862      LENS   = LEN(STR)
    865863      LENSS  = LEN(SSTR)
    866 !
     864
    867865      DO 10 I=1,LENS-LENSS+1
    868866          IF (STR(I:I+LENSS-1).NE.SSTR) THEN
    … …  
    872870   10 CONTINUE
    873871      INDEXC = 0
    874 !
     872
    875873  999 END

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

    r3888 r5099  
    1 !
     1
    22! $Id: compar1d.h 2010-08-04 17:02:56Z lahellec $
    3 !
     3
    44      integer :: forcing_type
    55      integer :: tend_u,tend_v,tend_w,tend_t,tend_q,tend_rayo

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

    r4603 r5099  
    1 !
     1
    22! $Id$
    3 !
     3
    44!#ifdef CPP_1D
    55!#include "../dyn3d/mod_const_mpi.F90"

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

    r5093 r5099  
    352352!---------------------------------------------------------------------------------------
    353353! Time interpolation of a 2D field to the timestep corresponding to day
    354 !
     354
    355355! day: current julian day (e.g. 717538.2)
    356356! day1: first day of the simulation

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

    r5088 r5099  
    823823!---------------------------------------------------------------------------------------
    824824! Time interpolation of a 2D field to the timestep corresponding to day
    825 !
     825
    826826! day: current julian day (e.g. 717538.2)
    827827! day1: first day of the simulation

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

    r5088 r5099  
    1 !
     1
    22! $Id: mod_1D_cases_read.F90 2373 2015-10-13 17:28:01Z jyg $
    3 !
     3
    44MODULE mod_1D_cases_read2
    55  USE netcdf, ONLY: nf90_get_var,nf90_noerr,nf90_inq_varid,nf90_inquire_dimension,nf90_strerror,nf90_open,&
    … …  
    372372    else
    373373       allocate(time_val(nt_cas))
    374        ierr = NF90_GET_VAR(nid,timeid,time_val)
     374       ierr = nf90_get_var(nid,timeid,time_val)
    375375       if(ierr/=nf90_noerr) then
    376376          print *,'Pb a la lecture de time cas.nc: '
    … …  
    582582     print *,'Dans read_cas2, on va lire ',var3didin(i),name_var(i)
    583583     if(i<=35) then
    584         ierr = NF90_GET_VAR(nid,var3didin(i),resul, count = [1, 1, nlevel, ntime])
     584        ierr = nf90_get_var(nid,var3didin(i),resul, count = [1, 1, nlevel, ntime])
    585585        print *,'Dans read_cas2, on a lu ',ierr,var3didin(i),name_var(i)
    586586        if(ierr/=nf90_noerr) then
    … …  
    590590     else
    591591        print *,'Dans read_cas2, on a lu ',ierr,var3didin(i),name_var(i)
    592         ierr = NF90_GET_VAR(nid,var3didin(i),resul1, count = [1, 1, ntime])
     592        ierr = nf90_get_var(nid,var3didin(i),resul1, count = [1, 1, ntime])
    593593        if(ierr/=nf90_noerr) then
    594594           print *,'Pb a la lecture de cas.nc: ',name_var(i)
    … …  
    702702        !-----------------------------------------------------------------------
    703703        if(i<=4) then     ! Lecture des coord pression en (nlevelp1,lat,lon)
    704            ierr = NF90_GET_VAR(nid,var3didin(i),apbp, count = [1, 1, nlevel + 1])
     704           ierr = nf90_get_var(nid,var3didin(i),apbp, count = [1, 1, nlevel + 1])
    705705           print *,'read2_cas(apbp), on a lu ',i,name_var(i)
    706706           if(ierr/=nf90_noerr) then
    … …  
    710710           !-----------------------------------------------------------------------
    711711        else if(i>4.and.i<=45) then   ! Lecture des variables en (time,nlevel,lat,lon)
    712            ierr = NF90_GET_VAR(nid,var3didin(i),resul, count = [1, 1, nlevel, ntime])
     712           ierr = nf90_get_var(nid,var3didin(i),resul, count = [1, 1, nlevel, ntime])
    713713           print *,'read2_cas(resul), on a lu ',i,name_var(i)
    714714           if(ierr/=nf90_noerr) then
    … …  
    718718           !-----------------------------------------------------------------------
    719719        else if (i>45.and.i<=51) then   ! Lecture des variables en (time,lat,lon)
    720            ierr = NF90_GET_VAR(nid,var3didin(i),resul2, count = [1, 1, ntime])
     720           ierr = nf90_get_var(nid,var3didin(i),resul2, count = [1, 1, ntime])
    721721           print *,'read2_cas(resul2), on a lu ',i,name_var(i)
    722722           if(ierr/=nf90_noerr) then
    … …  
    726726           !-----------------------------------------------------------------------
    727727        else     ! Lecture des constantes (lat,lon)
    728            ierr = NF90_GET_VAR(nid,var3didin(i),resul3)
     728           ierr = nf90_get_var(nid,var3didin(i),resul3)
    729729           print *,'read2_cas(resul3), on a lu ',i,name_var(i)
    730730           if(ierr/=nf90_noerr) then
    … …  
    877877        !-----------------------------------------------------------------------
    878878        if(i<=4) then     ! Lecture des coord pression en (nlevelp1,lat,lon)
    879            ierr = NF90_GET_VAR(nid,var3didin(i),apbp)
     879           ierr = nf90_get_var(nid,var3didin(i),apbp)
    880880           print *,'read2_cas(apbp), on a lu ',i,name_var(i)
    881881           if(ierr/=nf90_noerr) then
    … …  
    885885           !-----------------------------------------------------------------------
    886886        else if(i>4.and.i<=12) then   ! Lecture des variables en (time,nlevel,lat,lon)
    887            ierr = NF90_GET_VAR(nid,var3didin(i),resul1)
     887           ierr = nf90_get_var(nid,var3didin(i),resul1)
    888888           print *,'read2_cas(resul1), on a lu ',i,name_var(i)
    889889           if(ierr/=nf90_noerr) then
    … …  
    894894           !-----------------------------------------------------------------------
    895895        else if(i>12.and.i<=54) then   ! Lecture des variables en (time,nlevel,lat,lon)
    896            ierr = NF90_GET_VAR(nid,var3didin(i),resul)
     896           ierr = nf90_get_var(nid,var3didin(i),resul)
    897897           print *,'read2_cas(resul), on a lu ',i,name_var(i)
    898898           if(ierr/=nf90_noerr) then
    … …  
    903903           !-----------------------------------------------------------------------
    904904        else if (i>54.and.i<=65) then   ! Lecture des variables en (time,lat,lon)
    905            ierr = NF90_GET_VAR(nid,var3didin(i),resul2)
     905           ierr = nf90_get_var(nid,var3didin(i),resul2)
    906906           print *,'read2_cas(resul2), on a lu ',i,name_var(i)
    907907           if(ierr/=nf90_noerr) then
    … …  
    912912           !-----------------------------------------------------------------------
    913913        else     ! Lecture des constantes (lat,lon)
    914            ierr = NF90_GET_VAR(nid,var3didin(i),resul3)
     914           ierr = nf90_get_var(nid,var3didin(i),resul3)
    915915           print *,'read2_cas(resul3), on a lu ',i,name_var(i)
    916916           if(ierr/=nf90_noerr) then
    … …  
    10421042  !---------------------------------------------------------------------------------------
    10431043  ! Time interpolation of a 2D field to the timestep corresponding to day
    1044   !
     1044
    10451045  ! day: current julian day (e.g. 717538.2)
    10461046  ! day1: first day of the simulation
    … …  
    12351235     ,lat_cas,sens_cas,ustar_cas                                        &
    12361236     ,uw_cas,vw_cas,q1_cas,q2_cas,tke_cas                               &
    1237      !
     1237
    12381238     ,ts_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas               &
    12391239     ,thv_prof_cas,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas     &
    … …  
    12511251  !---------------------------------------------------------------------------------------
    12521252  ! Time interpolation of a 2D field to the timestep corresponding to day
    1253   !
     1253
    12541254  ! day: current julian day (e.g. 717538.2)
    12551255  ! day1: first day of the simulation

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

    r5088 r5099  
    1 !
     1
    22! $Id: mod_1D_cases_read.F90 2373 2015-10-13 17:28:01Z jyg $
    3 !
     3
    44MODULE mod_1D_cases_read_std
    55  USE netcdf, ONLY:nf90_noerr,nf90_inq_varid,nf90_inq_dimid,nf90_inquire_dimension,nf90_open,nf90_nowrite,&
    … …  
    147147    else
    148148       allocate(time_val(nt_cas))
    149        ierr = NF90_GET_VAR(nid,timeid,time_val)
     149       ierr = nf90_get_var(nid,timeid,time_val)
    150150       if(ierr/=nf90_noerr) then
    151151          print *,'A Pb a la lecture de time cas.nc: '
    … …  
    454454          !-----------------------------------------------------------------------
    455455          if(i<=4) then
    456              ierr = NF90_GET_VAR(nid,var3didin(i),apbp)
     456             ierr = nf90_get_var(nid,var3didin(i),apbp)
    457457             print *,'read_SCM(apbp), on a lu ',i,name_var(i)
    458458             if(ierr/=nf90_noerr) then
    … …  
    465465             !-----------------------------------------------------------------------
    466466          else if(i>4.and.i<=12) then
    467              ierr = NF90_GET_VAR(nid,var3didin(i),resul1)
     467             ierr = nf90_get_var(nid,var3didin(i),resul1)
    468468             print *,'read_SCM(resul1), on a lu ',i,name_var(i)
    469469             if(ierr/=nf90_noerr) then
    … …  
    478478             !-----------------------------------------------------------------------
    479479          else if(i>12.and.i<=61) then
    480              ierr = NF90_GET_VAR(nid,var3didin(i),resul)
     480             ierr = nf90_get_var(nid,var3didin(i),resul)
    481481             print *,'read_SCM(resul), on a lu ',i,name_var(i)
    482482             if(ierr/=nf90_noerr) then
    … …  
    490490             !-----------------------------------------------------------------------
    491491          else if (i>62.and.i<=75) then
    492              ierr = NF90_GET_VAR(nid,var3didin(i),resul2)
     492             ierr = nf90_get_var(nid,var3didin(i),resul2)
    493493             print *,'read_SCM(resul2), on a lu ',i,name_var(i)
    494494             if(ierr/=nf90_noerr) then
    … …  
    502502             !-----------------------------------------------------------------------
    503503          else
    504              ierr = NF90_GET_VAR(nid,var3didin(i),resul3)
     504             ierr = nf90_get_var(nid,var3didin(i),resul3)
    505505             print *,'read_SCM(resul3), on a lu ',i,name_var(i)
    506506             if(ierr/=nf90_noerr) then
    … …  
    640640       ,lat_cas,sens_cas,ustar_cas                                        &
    641641       ,uw_cas,vw_cas,q1_cas,q2_cas,tkes_cas                               &
    642        !
     642
    643643       ,ts_prof_cas,tskin_prof_cas,ps_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas               &
    644644       ,thv_prof_cas,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas     &
    … …  
    662662    !---------------------------------------------------------------------------------------
    663663    ! Time interpolation of a 2D field to the timestep corresponding to day
    664     !
     664
    665665    ! day: current julian day (e.g. 717538.2)
    666666    ! day1: first day of the simulation
    … …  
    919919       ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas &
    920920       ,dth_prof_cas,hth_prof_cas,vth_prof_cas                                                 &
    921        !
     921
    922922       ,t_mod_cas,theta_mod_cas,thv_mod_cas,thl_mod_cas                                        &
    923923       ,qv_mod_cas,ql_mod_cas,qi_mod_cas,u_mod_cas,v_mod_cas                                   &

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

    r5088 r5099  
    314314       enddo
    315315         
    316          ierr = NF90_GET_VAR(nid,var3didin(1),lat)
     316         ierr = nf90_get_var(nid,var3didin(1),lat)
    317317         if(ierr/=nf90_noerr) then
    318318            write(*,*) nf90_strerror(ierr)
    … …  
    321321!         write(*,*)'lecture lat ok',lat
    322322
    323          ierr = NF90_GET_VAR(nid,var3didin(2),lon)
     323         ierr = nf90_get_var(nid,var3didin(2),lon)
    324324         if(ierr/=nf90_noerr) then
    325325            write(*,*) nf90_strerror(ierr)
    … …  
    328328!         write(*,*)'lecture lon ok',lon
    329329 
    330          ierr = NF90_GET_VAR(nid,var3didin(3),alt)
     330         ierr = nf90_get_var(nid,var3didin(3),alt)
    331331         if(ierr/=nf90_noerr) then
    332332            write(*,*) nf90_strerror(ierr)
    … …  
    335335!          write(*,*)'lecture alt ok',alt
    336336 
    337          ierr = NF90_GET_VAR(nid,var3didin(4),phis)
     337         ierr = nf90_get_var(nid,var3didin(4),phis)
    338338         if(ierr/=nf90_noerr) then
    339339            write(*,*) nf90_strerror(ierr)
    … …  
    342342!          write(*,*)'lecture phis ok',phis
    343343         
    344          ierr = NF90_GET_VAR(nid,var3didin(5),T)
     344         ierr = nf90_get_var(nid,var3didin(5),T)
    345345         if(ierr/=nf90_noerr) then
    346346            write(*,*) nf90_strerror(ierr)
    … …  
    349349!         write(*,*)'lecture T ok'
    350350
    351          ierr = NF90_GET_VAR(nid,var3didin(6),q)
     351         ierr = nf90_get_var(nid,var3didin(6),q)
    352352         if(ierr/=nf90_noerr) then
    353353            write(*,*) nf90_strerror(ierr)
    … …  
    361361       enddo
    362362       enddo
    363          ierr = NF90_GET_VAR(nid,var3didin(7),u)
     363         ierr = nf90_get_var(nid,var3didin(7),u)
    364364         if(ierr/=nf90_noerr) then
    365365            write(*,*) nf90_strerror(ierr)
    … …  
    368368!         write(*,*)'lecture u ok'
    369369
    370          ierr = NF90_GET_VAR(nid,var3didin(8),v)
     370         ierr = nf90_get_var(nid,var3didin(8),v)
    371371         if(ierr/=nf90_noerr) then
    372372            write(*,*) nf90_strerror(ierr)
    … …  
    375375!         write(*,*)'lecture v ok'
    376376
    377          ierr = NF90_GET_VAR(nid,var3didin(9),omega)
     377         ierr = nf90_get_var(nid,var3didin(9),omega)
    378378         if(ierr/=nf90_noerr) then
    379379            write(*,*) nf90_strerror(ierr)
    … …  
    388388       enddo
    389389
    390          ierr = NF90_GET_VAR(nid,var3didin(10),div)
     390         ierr = nf90_get_var(nid,var3didin(10),div)
    391391         if(ierr/=nf90_noerr) then
    392392            write(*,*) nf90_strerror(ierr)
    … …  
    395395!         write(*,*)'lecture div ok'
    396396
    397          ierr = NF90_GET_VAR(nid,var3didin(11),T_adv_h)
     397         ierr = nf90_get_var(nid,var3didin(11),T_adv_h)
    398398         if(ierr/=nf90_noerr) then
    399399            write(*,*) nf90_strerror(ierr)
    … …  
    409409
    410410
    411          ierr = NF90_GET_VAR(nid,var3didin(12),T_adv_v)
     411         ierr = nf90_get_var(nid,var3didin(12),T_adv_v)
    412412         if(ierr/=nf90_noerr) then
    413413            write(*,*) nf90_strerror(ierr)
    … …  
    422422       enddo
    423423
    424          ierr = NF90_GET_VAR(nid,var3didin(13),q_adv_h)
     424         ierr = nf90_get_var(nid,var3didin(13),q_adv_h)
    425425         if(ierr/=nf90_noerr) then
    426426            write(*,*) nf90_strerror(ierr)
    … …  
    436436
    437437
    438          ierr = NF90_GET_VAR(nid,var3didin(14),q_adv_v)
     438         ierr = nf90_get_var(nid,var3didin(14),q_adv_v)
    439439         if(ierr/=nf90_noerr) then
    440440            write(*,*) nf90_strerror(ierr)
    … …  
    450450
    451451
    452          ierr = NF90_GET_VAR(nid,var3didin(15),s)
    453          if(ierr/=nf90_noerr) then
    454             write(*,*) nf90_strerror(ierr)
    455             stop "getvarup"
    456          endif
    457 
    458          ierr = NF90_GET_VAR(nid,var3didin(16),s_adv_h)
    459          if(ierr/=nf90_noerr) then
    460             write(*,*) nf90_strerror(ierr)
    461             stop "getvarup"
    462          endif
    463 
    464          ierr = NF90_GET_VAR(nid,var3didin(17),s_adv_v)
    465          if(ierr/=nf90_noerr) then
    466             write(*,*) nf90_strerror(ierr)
    467             stop "getvarup"
    468          endif
    469 
    470          ierr = NF90_GET_VAR(nid,var3didin(18),p_srf_aver)
    471          if(ierr/=nf90_noerr) then
    472             write(*,*) nf90_strerror(ierr)
    473             stop "getvarup"
    474          endif
    475 
    476          ierr = NF90_GET_VAR(nid,var3didin(19),p_srf_center)
    477          if(ierr/=nf90_noerr) then
    478             write(*,*) nf90_strerror(ierr)
    479             stop "getvarup"
    480          endif
    481 
    482          ierr = NF90_GET_VAR(nid,var3didin(20),T_srf)
     452         ierr = nf90_get_var(nid,var3didin(15),s)
     453         if(ierr/=nf90_noerr) then
     454            write(*,*) nf90_strerror(ierr)
     455            stop "getvarup"
     456         endif
     457
     458         ierr = nf90_get_var(nid,var3didin(16),s_adv_h)
     459         if(ierr/=nf90_noerr) then
     460            write(*,*) nf90_strerror(ierr)
     461            stop "getvarup"
     462         endif
     463
     464         ierr = nf90_get_var(nid,var3didin(17),s_adv_v)
     465         if(ierr/=nf90_noerr) then
     466            write(*,*) nf90_strerror(ierr)
     467            stop "getvarup"
     468         endif
     469
     470         ierr = nf90_get_var(nid,var3didin(18),p_srf_aver)
     471         if(ierr/=nf90_noerr) then
     472            write(*,*) nf90_strerror(ierr)
     473            stop "getvarup"
     474         endif
     475
     476         ierr = nf90_get_var(nid,var3didin(19),p_srf_center)
     477         if(ierr/=nf90_noerr) then
     478            write(*,*) nf90_strerror(ierr)
     479            stop "getvarup"
     480         endif
     481
     482         ierr = nf90_get_var(nid,var3didin(20),T_srf)
    483483         if(ierr/=nf90_noerr) then
    484484            write(*,*) nf90_strerror(ierr)
    … …  
    530530         endif
    531531
    532          ierr = NF90_GET_VAR(nid,timevar,time)
    533          ierr = NF90_GET_VAR(nid,levvar,lev)
     532         ierr = nf90_get_var(nid,timevar,time)
     533         ierr = nf90_get_var(nid,levvar,lev)
    534534
    535535       return
    … …  
    943943!---------------------------------------------------------------------------------------
    944944! Time interpolation of a 2D field to the timestep corresponding to day
    945 !
     945
    946946! day: current julian day (e.g. 717538.2)
    947947! day1: first day of the simulation
    … …  
    14621462!---------------------------------------------------------------------------------------
    14631463! Time interpolation of a 2D field to the timestep corresponding to day
    1464 !
     1464
    14651465! day: current julian day (e.g. 717538.2)
    14661466! day1: first day of the simulation
    … …  
    15541554!---------------------------------------------------------------------------------------
    15551555! Time interpolation of a 2D field to the timestep corresponding to day
    1556 !
     1556
    15571557! day: current julian day (e.g. 717538.2)
    15581558! day1: first day of the simulation
    … …  
    16961696!---------------------------------------------------------------------------------------
    16971697! Time interpolation of a 2D field to the timestep corresponding to day
    1698 !
     1698
    16991699! day: current julian day (e.g. 717538.2)
    17001700! day1: first day of the simulation
    … …  
    18091809!---------------------------------------------------------------------------------------
    18101810! Time interpolation of a 2D field to the timestep corresponding to day
    1811 !
     1811
    18121812! day: current julian day
    18131813! day1: first day of the simulation
    … …  
    18961896!---------------------------------------------------------------------------------------
    18971897! Time interpolation of a 2D field to the timestep corresponding to day
    1898 !
     1898
    18991899! day: current julian day (e.g. 717538.2)
    19001900! day1: first day of the simulation
    … …  
    22792279!      call catchaxis(nid,ntime,nlevel,time,z,ierr)
    22802280 
    2281          ierr = NF90_GET_VAR(nid,var3didin(1),zz)
     2281         ierr = nf90_get_var(nid,var3didin(1),zz)
    22822282         if(ierr/=nf90_noerr) then
    22832283            write(*,*) nf90_strerror(ierr)
    … …  
    22862286!          write(*,*)'lecture z ok',zz
    22872287
    2288          ierr = NF90_GET_VAR(nid,var3didin(2),thl)
     2288         ierr = nf90_get_var(nid,var3didin(2),thl)
    22892289         if(ierr/=nf90_noerr) then
    22902290            write(*,*) nf90_strerror(ierr)
    … …  
    22932293!          write(*,*)'lecture thl ok',thl
    22942294
    2295          ierr = NF90_GET_VAR(nid,var3didin(3),qt)
     2295         ierr = nf90_get_var(nid,var3didin(3),qt)
    22962296         if(ierr/=nf90_noerr) then
    22972297            write(*,*) nf90_strerror(ierr)
    … …  
    23002300!          write(*,*)'lecture qt ok',qt
    23012301 
    2302          ierr = NF90_GET_VAR(nid,var3didin(4),u)
     2302         ierr = nf90_get_var(nid,var3didin(4),u)
    23032303         if(ierr/=nf90_noerr) then
    23042304            write(*,*) nf90_strerror(ierr)
    … …  
    23072307!          write(*,*)'lecture u ok',u
    23082308
    2309          ierr = NF90_GET_VAR(nid,var3didin(5),v)
     2309         ierr = nf90_get_var(nid,var3didin(5),v)
    23102310         if(ierr/=nf90_noerr) then
    23112311            write(*,*) nf90_strerror(ierr)
    … …  
    23142314!          write(*,*)'lecture v ok',v
    23152315
    2316          ierr = NF90_GET_VAR(nid,var3didin(6),tke)
     2316         ierr = nf90_get_var(nid,var3didin(6),tke)
    23172317         if(ierr/=nf90_noerr) then
    23182318            write(*,*) nf90_strerror(ierr)
    … …  
    23212321!          write(*,*)'lecture tke ok',tke
    23222322
    2323          ierr = NF90_GET_VAR(nid,var3didin(7),ug)
     2323         ierr = nf90_get_var(nid,var3didin(7),ug)
    23242324         if(ierr/=nf90_noerr) then
    23252325            write(*,*) nf90_strerror(ierr)
    … …  
    23282328!          write(*,*)'lecture ug ok',ug
    23292329
    2330          ierr = NF90_GET_VAR(nid,var3didin(8),vg)
     2330         ierr = nf90_get_var(nid,var3didin(8),vg)
    23312331         if(ierr/=nf90_noerr) then
    23322332            write(*,*) nf90_strerror(ierr)
    … …  
    23352335!          write(*,*)'lecture vg ok',vg
    23362336
    2337          ierr = NF90_GET_VAR(nid,var3didin(9),wls)
     2337         ierr = nf90_get_var(nid,var3didin(9),wls)
    23382338         if(ierr/=nf90_noerr) then
    23392339            write(*,*) nf90_strerror(ierr)
    … …  
    23422342!          write(*,*)'lecture wls ok',wls
    23432343
    2344          ierr = NF90_GET_VAR(nid,var3didin(10),dqtdx)
     2344         ierr = nf90_get_var(nid,var3didin(10),dqtdx)
    23452345         if(ierr/=nf90_noerr) then
    23462346            write(*,*) nf90_strerror(ierr)
    … …  
    23492349!          write(*,*)'lecture dqtdx ok',dqtdx
    23502350
    2351          ierr = NF90_GET_VAR(nid,var3didin(11),dqtdy)
     2351         ierr = nf90_get_var(nid,var3didin(11),dqtdy)
    23522352         if(ierr/=nf90_noerr) then
    23532353            write(*,*) nf90_strerror(ierr)
    … …  
    23562356!          write(*,*)'lecture dqtdy ok',dqtdy
    23572357
    2358          ierr = NF90_GET_VAR(nid,var3didin(12),dqtdt)
     2358         ierr = nf90_get_var(nid,var3didin(12),dqtdt)
    23592359         if(ierr/=nf90_noerr) then
    23602360            write(*,*) nf90_strerror(ierr)
    … …  
    23632363!          write(*,*)'lecture dqtdt ok',dqtdt
    23642364
    2365          ierr = NF90_GET_VAR(nid,var3didin(13),thl_rad)
     2365         ierr = nf90_get_var(nid,var3didin(13),thl_rad)
    23662366         if(ierr/=nf90_noerr) then
    23672367            write(*,*) nf90_strerror(ierr)
    … …  
    25492549!      call catchaxis(nid,ntime,nlevel,time,z,ierr)
    25502550 
    2551          ierr = NF90_GET_VAR(nid,var3didin(1),zz)
     2551         ierr = nf90_get_var(nid,var3didin(1),zz)
    25522552         if(ierr/=nf90_noerr) then
    25532553            write(*,*) nf90_strerror(ierr)
    … …  
    25562556!          write(*,*)'lecture zz ok',zz
    25572557 
    2558          ierr = NF90_GET_VAR(nid,var3didin(11),pres)
     2558         ierr = nf90_get_var(nid,var3didin(11),pres)
    25592559         if(ierr/=nf90_noerr) then
    25602560            write(*,*) nf90_strerror(ierr)
    … …  
    25632563!          write(*,*)'lecture pres ok',pres
    25642564
    2565          ierr = NF90_GET_VAR(nid,var3didin(12),th)
     2565         ierr = nf90_get_var(nid,var3didin(12),th)
    25662566         if(ierr/=nf90_noerr) then
    25672567            write(*,*) nf90_strerror(ierr)
    … …  
    25732573           enddo
    25742574
    2575          ierr = NF90_GET_VAR(nid,var3didin(13),qv)
     2575         ierr = nf90_get_var(nid,var3didin(13),qv)
    25762576         if(ierr/=nf90_noerr) then
    25772577            write(*,*) nf90_strerror(ierr)
    … …  
    25802580!          write(*,*)'lecture qv ok',qv
    25812581 
    2582          ierr = NF90_GET_VAR(nid,var3didin(14),u)
     2582         ierr = nf90_get_var(nid,var3didin(14),u)
    25832583         if(ierr/=nf90_noerr) then
    25842584            write(*,*) nf90_strerror(ierr)
    … …  
    25872587!          write(*,*)'lecture u ok',u
    25882588
    2589          ierr = NF90_GET_VAR(nid,var3didin(15),v)
     2589         ierr = nf90_get_var(nid,var3didin(15),v)
    25902590         if(ierr/=nf90_noerr) then
    25912591            write(*,*) nf90_strerror(ierr)
    … …  
    25942594!          write(*,*)'lecture v ok',v
    25952595
    2596          ierr = NF90_GET_VAR(nid,var3didin(16),o3)
     2596         ierr = nf90_get_var(nid,var3didin(16),o3)
    25972597         if(ierr/=nf90_noerr) then
    25982598            write(*,*) nf90_strerror(ierr)
    … …  
    26012601!          write(*,*)'lecture o3 ok',o3
    26022602
    2603          ierr = NF90_GET_VAR(nid,var3didin(2),shf)
     2603         ierr = nf90_get_var(nid,var3didin(2),shf)
    26042604         if(ierr/=nf90_noerr) then
    26052605            write(*,*) nf90_strerror(ierr)
    … …  
    26082608!          write(*,*)'lecture shf ok',shf
    26092609
    2610          ierr = NF90_GET_VAR(nid,var3didin(3),lhf)
     2610         ierr = nf90_get_var(nid,var3didin(3),lhf)
    26112611         if(ierr/=nf90_noerr) then
    26122612            write(*,*) nf90_strerror(ierr)
    … …  
    26152615!          write(*,*)'lecture lhf ok',lhf
    26162616
    2617          ierr = NF90_GET_VAR(nid,var3didin(4),lwup)
     2617         ierr = nf90_get_var(nid,var3didin(4),lwup)
    26182618         if(ierr/=nf90_noerr) then
    26192619            write(*,*) nf90_strerror(ierr)
    … …  
    26222622!          write(*,*)'lecture lwup ok',lwup
    26232623
    2624          ierr = NF90_GET_VAR(nid,var3didin(5),swup)
     2624         ierr = nf90_get_var(nid,var3didin(5),swup)
    26252625         if(ierr/=nf90_noerr) then
    26262626            write(*,*) nf90_strerror(ierr)
    … …  
    26292629!          write(*,*)'lecture swup ok',swup
    26302630
    2631          ierr = NF90_GET_VAR(nid,var3didin(6),tg)
     2631         ierr = nf90_get_var(nid,var3didin(6),tg)
    26322632         if(ierr/=nf90_noerr) then
    26332633            write(*,*) nf90_strerror(ierr)
    … …  
    26362636!          write(*,*)'lecture tg ok',tg
    26372637
    2638          ierr = NF90_GET_VAR(nid,var3didin(7),ustar)
     2638         ierr = nf90_get_var(nid,var3didin(7),ustar)
    26392639         if(ierr/=nf90_noerr) then
    26402640            write(*,*) nf90_strerror(ierr)
    … …  
    26432643!          write(*,*)'lecture ustar ok',ustar
    26442644
    2645          ierr = NF90_GET_VAR(nid,var3didin(8),psurf)
     2645         ierr = nf90_get_var(nid,var3didin(8),psurf)
    26462646         if(ierr/=nf90_noerr) then
    26472647            write(*,*) nf90_strerror(ierr)
    … …  
    26502650!          write(*,*)'lecture psurf ok',psurf
    26512651
    2652          ierr = NF90_GET_VAR(nid,var3didin(9),ug)
     2652         ierr = nf90_get_var(nid,var3didin(9),ug)
    26532653         if(ierr/=nf90_noerr) then
    26542654            write(*,*) nf90_strerror(ierr)
    … …  
    26572657!          write(*,*)'lecture ug ok',ug
    26582658
    2659          ierr = NF90_GET_VAR(nid,var3didin(10),vg)
     2659         ierr = nf90_get_var(nid,var3didin(10),vg)
    26602660         if(ierr/=nf90_noerr) then
    26612661            write(*,*) nf90_strerror(ierr)
    … …  
    26642664!          write(*,*)'lecture vg ok',vg
    26652665
    2666          ierr = NF90_GET_VAR(nid,var3didin(17),hadvt)
     2666         ierr = nf90_get_var(nid,var3didin(17),hadvt)
    26672667         if(ierr/=nf90_noerr) then
    26682668            write(*,*) nf90_strerror(ierr)
    … …  
    26712671!          write(*,*)'lecture hadvt ok',hadvt
    26722672
    2673          ierr = NF90_GET_VAR(nid,var3didin(18),hadvq)
     2673         ierr = nf90_get_var(nid,var3didin(18),hadvq)
    26742674         if(ierr/=nf90_noerr) then
    26752675            write(*,*) nf90_strerror(ierr)
    … …  
    26782678!          write(*,*)'lecture hadvq ok',hadvq
    26792679
    2680          ierr = NF90_GET_VAR(nid,var3didin(19),hadvu)
     2680         ierr = nf90_get_var(nid,var3didin(19),hadvu)
    26812681         if(ierr/=nf90_noerr) then
    26822682            write(*,*) nf90_strerror(ierr)
    … …  
    26852685!          write(*,*)'lecture hadvu ok',hadvu
    26862686
    2687          ierr = NF90_GET_VAR(nid,var3didin(20),hadvv)
     2687         ierr = nf90_get_var(nid,var3didin(20),hadvv)
    26882688         if(ierr/=nf90_noerr) then
    26892689            write(*,*) nf90_strerror(ierr)
    … …  
    26922692!          write(*,*)'lecture hadvv ok',hadvv
    26932693
    2694          ierr = NF90_GET_VAR(nid,var3didin(21),w)
     2694         ierr = nf90_get_var(nid,var3didin(21),w)
    26952695         if(ierr/=nf90_noerr) then
    26962696            write(*,*) nf90_strerror(ierr)
    … …  
    26992699!          write(*,*)'lecture w ok',w
    27002700
    2701          ierr = NF90_GET_VAR(nid,var3didin(22),omega)
     2701         ierr = nf90_get_var(nid,var3didin(22),omega)
    27022702         if(ierr/=nf90_noerr) then
    27032703            write(*,*) nf90_strerror(ierr)
    … …  
    28442844!      call catchaxis(nid,ntime,nlevel,time,z,ierr)
    28452845 
    2846          ierr = NF90_GET_VAR(nid,var3didin(1),zz_i)
    2847          if(ierr/=nf90_noerr) then
    2848             write(*,*) nf90_strerror(ierr)
    2849             stop "getvarup"
    2850          endif
    2851  
    2852          ierr = NF90_GET_VAR(nid,var3didin(2),depth_sn)
    2853          if(ierr/=nf90_noerr) then
    2854             write(*,*) nf90_strerror(ierr)
    2855             stop "getvarup"
    2856          endif
    2857  
    2858          ierr = NF90_GET_VAR(nid,var3didin(3),ug_i)
    2859          if(ierr/=nf90_noerr) then
    2860             write(*,*) nf90_strerror(ierr)
    2861             stop "getvarup"
    2862          endif
    2863  
    2864          ierr = NF90_GET_VAR(nid,var3didin(4),vg_i)
    2865          if(ierr/=nf90_noerr) then
    2866             write(*,*) nf90_strerror(ierr)
    2867             stop "getvarup"
    2868          endif
    2869  
    2870          ierr = NF90_GET_VAR(nid,var3didin(5),pf_i)
    2871          if(ierr/=nf90_noerr) then
    2872             write(*,*) nf90_strerror(ierr)
    2873             stop "getvarup"
    2874          endif
    2875 
    2876          ierr = NF90_GET_VAR(nid,var3didin(6),th_i)
    2877          if(ierr/=nf90_noerr) then
    2878             write(*,*) nf90_strerror(ierr)
    2879             stop "getvarup"
    2880          endif
    2881 
    2882          ierr = NF90_GET_VAR(nid,var3didin(7),t_i)
    2883          if(ierr/=nf90_noerr) then
    2884             write(*,*) nf90_strerror(ierr)
    2885             stop "getvarup"
    2886          endif
    2887 
    2888          ierr = NF90_GET_VAR(nid,var3didin(8),qv_i)
    2889          if(ierr/=nf90_noerr) then
    2890             write(*,*) nf90_strerror(ierr)
    2891             stop "getvarup"
    2892          endif
    2893  
    2894          ierr = NF90_GET_VAR(nid,var3didin(9),u_i)
    2895          if(ierr/=nf90_noerr) then
    2896             write(*,*) nf90_strerror(ierr)
    2897             stop "getvarup"
    2898          endif
    2899  
    2900          ierr = NF90_GET_VAR(nid,var3didin(10),v_i)
    2901          if(ierr/=nf90_noerr) then
    2902             write(*,*) nf90_strerror(ierr)
    2903             stop "getvarup"
    2904          endif
    2905  
    2906          ierr = NF90_GET_VAR(nid,var3didin(11),hadvt_i)
    2907          if(ierr/=nf90_noerr) then
    2908             write(*,*) nf90_strerror(ierr)
    2909             stop "getvarup"
    2910          endif
    2911  
    2912          ierr = NF90_GET_VAR(nid,var3didin(12),hadvq_i)
    2913          if(ierr/=nf90_noerr) then
    2914             write(*,*) nf90_strerror(ierr)
    2915             stop "getvarup"
    2916          endif
    2917  
    2918          ierr = NF90_GET_VAR(nid,var3didin(14),tsnow)
    2919          if(ierr/=nf90_noerr) then
    2920             write(*,*) nf90_strerror(ierr)
    2921             stop "getvarup"
    2922          endif
    2923  
    2924          ierr = NF90_GET_VAR(nid,var3didin(15),snow_dens)
    2925          if(ierr/=nf90_noerr) then
    2926             write(*,*) nf90_strerror(ierr)
    2927             stop "getvarup"
    2928          endif
    2929 
    2930          ierr = NF90_GET_VAR(nid,var3didin(16),tg)
     2846         ierr = nf90_get_var(nid,var3didin(1),zz_i)
     2847         if(ierr/=nf90_noerr) then
     2848            write(*,*) nf90_strerror(ierr)
     2849            stop "getvarup"
     2850         endif
     2851 
     2852         ierr = nf90_get_var(nid,var3didin(2),depth_sn)
     2853         if(ierr/=nf90_noerr) then
     2854            write(*,*) nf90_strerror(ierr)
     2855            stop "getvarup"
     2856         endif
     2857 
     2858         ierr = nf90_get_var(nid,var3didin(3),ug_i)
     2859         if(ierr/=nf90_noerr) then
     2860            write(*,*) nf90_strerror(ierr)
     2861            stop "getvarup"
     2862         endif
     2863 
     2864         ierr = nf90_get_var(nid,var3didin(4),vg_i)
     2865         if(ierr/=nf90_noerr) then
     2866            write(*,*) nf90_strerror(ierr)
     2867            stop "getvarup"
     2868         endif
     2869 
     2870         ierr = nf90_get_var(nid,var3didin(5),pf_i)
     2871         if(ierr/=nf90_noerr) then
     2872            write(*,*) nf90_strerror(ierr)
     2873            stop "getvarup"
     2874         endif
     2875
     2876         ierr = nf90_get_var(nid,var3didin(6),th_i)
     2877         if(ierr/=nf90_noerr) then
     2878            write(*,*) nf90_strerror(ierr)
     2879            stop "getvarup"
     2880         endif
     2881
     2882         ierr = nf90_get_var(nid,var3didin(7),t_i)
     2883         if(ierr/=nf90_noerr) then
     2884            write(*,*) nf90_strerror(ierr)
     2885            stop "getvarup"
     2886         endif
     2887
     2888         ierr = nf90_get_var(nid,var3didin(8),qv_i)
     2889         if(ierr/=nf90_noerr) then
     2890            write(*,*) nf90_strerror(ierr)
     2891            stop "getvarup"
     2892         endif
     2893 
     2894         ierr = nf90_get_var(nid,var3didin(9),u_i)
     2895         if(ierr/=nf90_noerr) then
     2896            write(*,*) nf90_strerror(ierr)
     2897            stop "getvarup"
     2898         endif
     2899 
     2900         ierr = nf90_get_var(nid,var3didin(10),v_i)
     2901         if(ierr/=nf90_noerr) then
     2902            write(*,*) nf90_strerror(ierr)
     2903            stop "getvarup"
     2904         endif
     2905 
     2906         ierr = nf90_get_var(nid,var3didin(11),hadvt_i)
     2907         if(ierr/=nf90_noerr) then
     2908            write(*,*) nf90_strerror(ierr)
     2909            stop "getvarup"
     2910         endif
     2911 
     2912         ierr = nf90_get_var(nid,var3didin(12),hadvq_i)
     2913         if(ierr/=nf90_noerr) then
     2914            write(*,*) nf90_strerror(ierr)
     2915            stop "getvarup"
     2916         endif
     2917 
     2918         ierr = nf90_get_var(nid,var3didin(14),tsnow)
     2919         if(ierr/=nf90_noerr) then
     2920            write(*,*) nf90_strerror(ierr)
     2921            stop "getvarup"
     2922         endif
     2923 
     2924         ierr = nf90_get_var(nid,var3didin(15),snow_dens)
     2925         if(ierr/=nf90_noerr) then
     2926            write(*,*) nf90_strerror(ierr)
     2927            stop "getvarup"
     2928         endif
     2929
     2930         ierr = nf90_get_var(nid,var3didin(16),tg)
    29312931         if(ierr/=nf90_noerr) then
    29322932            write(*,*) nf90_strerror(ierr)

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

    r3780 r5099  
    1 !
     1
    22! $Id: 1D_interp_cases.h 3537 2019-06-19 08:29:16Z fhourdin $
    3 !
     3
    44!---------------------------------------------------------------------
    55! Forcing_LES case: constant dq_dyn
    … …  
    552552
    553553       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
    554 !
     554
    555555!      d_t_adv(l) = 0.0
    556556!      d_q_adv(l,1) = 0.0
    … …  
    634634
    635635       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
    636 !
     636
    637637!      d_t_adv(l) = 0.0
    638638!      d_q_adv(l,1) = 0.0
    … …  
    813813       flat=lat_prof_cas
    814814      ENDIF
    815 !
     815
    816816      IF (ok_prescr_ust) THEN
    817817       ust=ustar_prof_cas
    … …  
    841841     &       ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,lat_cas,sens_cas,ustar_cas       &
    842842     &       ,uw_cas,vw_cas,q1_cas,q2_cas,tke_cas                                           &
    843 !
     843
    844844     &       ,ts_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas,thv_prof_cas  &
    845845     &       ,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas                              &
    … …  
    864864     &         ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas    &
    865865     &         ,dth_prof_cas,hth_prof_cas,vth_prof_cas                                                    &
    866 !
     866
    867867     &         ,t_mod_cas,theta_mod_cas,thv_mod_cas,thl_mod_cas,qv_mod_cas,ql_mod_cas,qi_mod_cas          &
    868868     &         ,u_mod_cas,v_mod_cas,ug_mod_cas,vg_mod_cas,w_mod_cas,omega_mod_cas                         &
    … …  
    10241024       print *,'1D_interp: sens,flat',fsens,flat
    10251025      ENDIF
    1026 !
     1026
    10271027      IF (ok_prescr_ust) THEN
    10281028       ust=ustar_prof_cas

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

    r4275 r5099  
    1 !
     1
    22! $Id: 1D_read_forc_cases.h 3537 2019-06-19 08:29:16Z fhourdin $
    3 !
     3
    44!----------------------------------------------------------------------
    55! forcing_les = .T. : Impose a constant cooling
    … …  
    394394! vertical interpolation using TOGA interpolation routine:
    395395!      write(*,*)'avant interp vert', t_proftwp
    396 !
     396
    397397!     CALL interp_dice_time(daytime,day1,annee_ref
    398398!    i             ,year_ini_dice,day_ju_ini_dice,nt_dice,dt_dice
    … …  
    508508! vertical interpolation using TOGA interpolation routine:
    509509!      write(*,*)'avant interp vert', t_proftwp
    510 !
     510
    511511!     CALL interp_dice_time(daytime,day1,annee_ref
    512512!    i             ,year_ini_dice,day_ju_ini_dice,nt_dice,dt_dice
    … …  
    542542       ug(l)=ug_mod(l)
    543543       vg(l)=vg_mod(l)
    544        
    545 !
     544
    546545!       tg=tsurf
    547 !       
    548546
    549547       print *,'***** tsurf=',tsurf
    … …  
    605603! For this case, profiles are given for two vertical resolution
    606604! 19 or 40 levels
    607 !
     605
    608606! Comment from: http://www.knmi.nl/samenw/eurocs/ARM/profiles.html
    609607! Note that the initial profiles contain no liquid water!
    … …  
    932930     &       ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,lat_cas,sens_cas,ustar_cas       &
    933931     &       ,uw_cas,vw_cas,q1_cas,q2_cas,tke_cas                                           &
    934 !
     932
    935933     &       ,ts_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas,thv_prof_cas  &
    936934     &       ,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas                              &
    … …  
    955953     &         ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas    &
    956954     &         ,dth_prof_cas,hth_prof_cas,vth_prof_cas                                                    &
    957 !
     955
    958956     &         ,t_mod_cas,theta_mod_cas,thv_mod_cas,thl_mod_cas,qv_mod_cas,ql_mod_cas,qi_mod_cas          &
    959957     &         ,u_mod_cas,v_mod_cas,ug_mod_cas,vg_mod_cas,w_mod_cas,omega_mod_cas                         &
    … …  
    10021000       flat=-1.*lat_prof_cas
    10031001       ENDIF
    1004 !
     1002
    10051003       IF (ok_prescr_ust) THEN
    10061004       ust=ustar_prof_cas
    … …  
    10311029     &       ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,lat_cas,sens_cas,ustar_cas       &
    10321030     &       ,uw_cas,vw_cas,q1_cas,q2_cas,tke_cas                                           &
    1033 !
     1031
    10341032     &       ,ts_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas,thv_prof_cas  &
    10351033     &       ,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas                              &
    … …  
    10541052     &         ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas    &
    10551053     &         ,dth_prof_cas,hth_prof_cas,vth_prof_cas                                                    &
    1056 !
     1054
    10571055     &         ,t_mod_cas,theta_mod_cas,thv_mod_cas,thl_mod_cas,qv_mod_cas,ql_mod_cas,qi_mod_cas          &
    10581056     &         ,u_mod_cas,v_mod_cas,ug_mod_cas,vg_mod_cas,w_mod_cas,omega_mod_cas                         &
    … …  
    11021100       flat=-1.*lat_prof_cas
    11031101       ENDIF
    1104 !
     1102
    11051103       IF (ok_prescr_ust) THEN
    11061104       ust=ustar_prof_cas

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

    r5087 r5099  
    1 !
     1
    22! $Id: lmdz1d.F90 3540 2019-06-25 14:50:13Z fairhead $
    3 !
    43
    54      SUBROUTINE old_lmdz1d
    … …  
    164163! DECLARATIONS FOR EACH CASE
    165164!=====================================================================
    166 !
     165
    167166      INCLUDE "old_1D_decl_cases.h"
    168 !
     167
    169168!---------------------------------------------------------------------
    170169!  Declarations related to nudging
    … …  
    179178     real :: u_targ(llm)
    180179     real :: v_targ(llm)
    181 !
     180
    182181!---------------------------------------------------------------------
    183182!  Declarations related to vertical discretization:
    … …  
    258257      integer jcode
    259258      INTEGER read_climoz
    260 !
     259
    261260      integer :: it_end ! iteration number of the last call
    262261!Al1
    263262      integer ecrit_slab_oc !1=ecrit,-1=lit,0=no file
    264263      data ecrit_slab_oc/-1/
    265 !
     264
    266265!     if flag_inhib_forcing = 0, tendencies of forcing are added
    267266!                           <> 0, tendencies of forcing are not added
    … …  
    365364!             use geostrophic wind ug=10m/s vg=0m/s. Duration of the case 53100s
    366365!             Radiation to be switched off
    367 !
     366
    368367      if (forcing_type <=0) THEN
    369368       forcing_les = .true.
    … …  
    459458        if (forcing_toga.or.forcing_sandu.or.forcing_astex .or. forcing_dice)                 &
    460459      type_ts_forcing = 1
    461 !
     460
    462461! Initialization of the logical switch for nudging
    463462     jcode = iflag_nudge
    … …  
    513512      endif
    514513!-----------------------------------------------------------------------
    515 !
     514
    516515!c Date :
    517516!      La date est supposee donnee sous la forme [annee, numero du jour dans
    … …  
    631630      d_q_nudge(:,:) = 0.
    632631
    633 !
    634632!   No ozone climatology need be read in this pre-initialization
    635633!          (phys_state_var_init is called again in physiq)
    … …  
    666664      rho(1)=psurf/(rd*tsurf*(1.+(rv/rd-1.)*qsurf))
    667665
    668 !
    669666!! mpl et jyg le 22/08/2012 :
    670667!!  pour que les cas a flux de surface imposes marchent
    … …  
    718715      ENDIF
    719716
    720 !
    721717!=====================================================================
    722718! EVENTUALLY, READ FORCING DATA :
    … …  
    743739
    744740!  Rq: conf_phys.F90 lit tous les flags de physiq.def; conf_phys appele depuis physiq.F
    745 !
     741
    746742! day_step, iphysiq lus dans gcm.def ci-dessus
    747743! timestep: calcule ci-dessous from rday et day_step
    … …  
    757753      timestep =rday/day_step
    758754      dtime_frcg = timestep
    759 !
     755
    760756      zcufi=airefi
    761757      zcvfi=airefi
    762 !
     758
    763759      rlat_rad(1)=xlat*rpi/180.
    764760      rlon_rad(1)=xlon*rpi/180.
    … …  
    899895        sig1=0.
    900896        w01=0.
    901 !
     897
    902898        wake_deltaq = 0.
    903899        wake_deltat = 0.
    … …  
    932928!------------------------------------------------------------------------
    933929! Make file containing restart for the physics (startphy.nc)
    934 !
     930
    935931! NB: List of the variables to be written by phyredem (via put_field):
    936932! rlon,rlat,zmasq,pctsrf(:,is_ter),pctsrf(:,is_lic),pctsrf(:,is_oce)
    … …  
    943939! wake_deltat,wake_deltaq,wake_s,awake_s,wake_dens,awake_dens,cv_gen,wake_cstar,
    944940! wake_fip,wake_delta_pbl_tke(:,1:klev,nsrf)
    945 !
     941
    946942! NB2: The content of the startphy.nc file depends on some flags defined in
    947943! the ".def" files. However, since conf_phys is not called in lmdz1d.F90, these flags have
    … …  
    10281024         open(97,file='div_slab.dat',STATUS='OLD')
    10291025       endif
    1030 !
     1026
    10311027!---------------------------------------------------------------------
    10321028!    Initialize target profile for RHT nudging if needed
    … …  
    10381034        call nudge_UV_init(plev,play,u,v,u_targ,v_targ)
    10391035      endif
    1040 !
     1036
    10411037!=====================================================================
    10421038#ifdef OUTPUT_PHYS_SCM
    … …  
    11961192       cfdt = cos(0.5*fcoriolis*timestep)
    11971193!       print *,'fcoriolis,sfdt,cfdt,timestep',fcoriolis,sfdt,cfdt,timestep
    1198 !
     1194
    11991195        du_age(1:mxcalc)= -2.*sfdt/timestep*                                &
    12001196            (sfdt*(u(1:mxcalc)-ug(1:mxcalc)) -                          &
    12011197             cfdt*(v(1:mxcalc)-vg(1:mxcalc))  )
    12021198!!     : fcoriolis*(v(1:mxcalc)-vg(1:mxcalc))
    1203 !
     1199
    12041200       dv_age(1:mxcalc)= -2.*sfdt/timestep*                                 &
    12051201            (cfdt*(u(1:mxcalc)-ug(1:mxcalc)) +                           &
    12061202             sfdt*(v(1:mxcalc)-vg(1:mxcalc))  )
    12071203!!     : -fcoriolis*(u(1:mxcalc)-ug(1:mxcalc))
    1208 !
     1204
    12091205!!!!!!!!!!!!!!!!!!!!!!!!
    12101206!  Nudging
    … …  
    12221218                    d_u_nudge,d_v_nudge)
    12231219      endif
    1224 !
     1220
    12251221       if (forcing_fire) THEN
    12261222
    … …  
    12511247!         call  writefield_phy('u_tend' ,u,llm)
    12521248!         call  writefield_phy('u_g' ,ug,llm)
    1253 !
     1249
    12541250!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    12551251!! Increment state variables
    … …  
    13011297
    13021298        teta=temp*(pzero/play)**rkappa
    1303 !
     1299
    13041300!---------------------------------------------------------------------
    13051301!   Nudge soil temperature if requested

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

    r5087 r5099  
    9898! comments
    9999!=======================================================================
    100 !
     100
    101101!  Input: modname = name of calling program
    102102!         message = stuff to print
    … …  
    113113      write(*,*) 'Reason = ',message
    114114      call getin_dump
    115 !
     115
    116116      if (ierr == 0) then
    117117        write(*,*) 'Everything is cool'

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

    r5087 r5099  
    128128! DECLARATIONS FOR EACH CASE
    129129!=====================================================================
    130 !
     130
    131131      INCLUDE "1D_decl_cases.h"
    132 !
     132
    133133!---------------------------------------------------------------------
    134134!  Declarations related to nudging
    … …  
    143143     real :: u_targ(llm)
    144144     real :: v_targ(llm)
    145 !
     145
    146146!---------------------------------------------------------------------
    147147!  Declarations related to vertical discretization:
    … …  
    223223      integer jcode
    224224      INTEGER read_climoz
    225 !
     225
    226226      integer :: it_end ! iteration number of the last call
    227227!Al1,plev,play,phi,phis,presnivs,
    228228      integer ecrit_slab_oc !1=ecrit,-1=lit,0=no file
    229229      data ecrit_slab_oc/-1/
    230 !
     230
    231231!     if flag_inhib_forcing = 0, tendencies of forcing are added
    232232!                           <> 0, tendencies of forcing are not added
    … …  
    287287
    288288      print*,'NATURE DE LA SURFACE ',nat_surf
    289 !
     289
    290290! Initialization of the logical switch for nudging
    291291
    … …  
    344344      endif
    345345!-----------------------------------------------------------------------
    346 !
     346
    347347!c Date :
    348348!      La date est supposee donnee sous la forme [annee, numero du jour dans
    … …  
    409409      d_q_nudge(:,:) = 0.
    410410
    411 !
    412411!   No ozone climatology need be read in this pre-initialization
    413412!          (phys_state_var_init is called again in physiq)
    … …  
    436435      rho(1)=psurf/(rd*tsurf*(1.+(rv/rd-1.)*qsurf))
    437436
    438 !
    439437!! mpl et jyg le 22/08/2012 :
    440438!!  pour que les cas a flux de surface imposes marchent
    … …  
    484482      ENDIF
    485483
    486 !
    487484!=====================================================================
    488485! EVENTUALLY, READ FORCING DATA :
    … …  
    503500
    504501!  Rq: conf_phys.F90 lit tous les flags de physiq.def; conf_phys appele depuis physiq.F
    505 !
     502
    506503! day_step, iphysiq lus dans gcm.def ci-dessus
    507504! timestep: calcule ci-dessous from rday et day_step
    … …  
    519516      timestep =rday/day_step
    520517      dtime_frcg = timestep
    521 !
     518
    522519      zcufi=airefi
    523520      zcvfi=airefi
    524 !
     521
    525522      rlat_rad(1)=xlat*rpi/180.
    526523      rlon_rad(1)=xlon*rpi/180.
    … …  
    655652        sig1=0.
    656653        w01=0.
    657 !
     654
    658655        wake_deltaq = 0.
    659656        wake_deltat = 0.
    … …  
    689686!------------------------------------------------------------------------
    690687! Make file containing restart for the physics (startphy.nc)
    691 !
     688
    692689! NB: List of the variables to be written by phyredem (via put_field):
    693690! rlon,rlat,zmasq,pctsrf(:,is_ter),pctsrf(:,is_lic),pctsrf(:,is_oce)
    … …  
    700697! wake_deltat,wake_deltaq,wake_s,awake_s,wake_dens,awake_dens,cv_gen,wake_cstar,
    701698! wake_fip,wake_delta_pbl_tke(:,1:klev,nsrf)
    702 !
     699
    703700! NB2: The content of the startphy.nc file depends on some flags defined in
    704701! the ".def" files. However, since conf_phys is not called in lmdz1d.F90, these flags have
    … …  
    785782         open(97,file='div_slab.dat',STATUS='OLD')
    786783       endif
    787 !
     784
    788785!=====================================================================
    789786#ifdef OUTPUT_PHYS_SCM
    … …  
    927924             cfdt*(v(1:mxcalc)-vg(1:mxcalc))  )
    928925!!     : fcoriolis*(v(1:mxcalc)-vg(1:mxcalc))
    929 !
     926
    930927       d_v_age(1:mxcalc)= -2.*sfdt/timestep*                                 &
    931928            (cfdt*(u(1:mxcalc)-ug(1:mxcalc)) +                           &
    … …  
    933930!!     : -fcoriolis*(u(1:mxcalc)-ug(1:mxcalc))
    934931      ENDIF
    935 !
     932
    936933!---------------------------------------------------------------------
    937934!  Nudging
Note: See TracChangeset for help on using the changeset viewer.