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

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

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/phylmd/calltherm.F90

    r5116 r5117  
    3434      USE lmdz_abort_physic, ONLY: abort_physic
    3535#ifdef ISO
    36       use infotrac_phy, ONLY: ntiso
     36      USE infotrac_phy, ONLY: ntiso
    3737#ifdef ISOVERIF
    3838      USE isotopes_mod, ONLY: iso_eau,iso_HDO
    … …  
    6666      REAL pplay(klon,klev)
    6767      REAL pphi(klon,klev)
    68       real zlev(klon,klev+1)
     68      REAL zlev(klon,klev+1)
    6969!test: on sort lentr et a* pour alimenter KE
    7070      REAL wght_th(klon,klev)
    … …  
    7575      REAL d_t_ajs(klon,klev), d_q_ajs(klon,klev)
    7676      REAL d_u_ajs(klon,klev),d_v_ajs(klon,klev)
    77       real fm_therm(klon,klev+1)
    78       real entr_therm(klon,klev),detr_therm(klon,klev)
     77      REAL fm_therm(klon,klev+1)
     78      REAL entr_therm(klon,klev),detr_therm(klon,klev)
    7979
    8080!********************************************************
    8181!     declarations
    8282      LOGICAL flag_bidouille_stratocu
    83       real fmc_therm(klon,klev+1),zqasc(klon,klev)
    84       real zqla(klon,klev)
    85       real ztv(klon,klev),ztva(klon,klev)
    86       real zpspsk(klon,klev)
    87       real ztla(klon,klev)
    88       real zthl(klon,klev)
    89       real wmax_sec(klon)
    90       real zcong(klon)
    91       real zmax_sec(klon)
    92       real f_sec(klon)
    93       real detrc_therm(klon,klev)
     83      REAL fmc_therm(klon,klev+1),zqasc(klon,klev)
     84      REAL zqla(klon,klev)
     85      REAL ztv(klon,klev),ztva(klon,klev)
     86      REAL zpspsk(klon,klev)
     87      REAL ztla(klon,klev)
     88      REAL zthl(klon,klev)
     89      REAL wmax_sec(klon)
     90      REAL zcong(klon)
     91      REAL zmax_sec(klon)
     92      REAL f_sec(klon)
     93      REAL detrc_therm(klon,klev)
    9494! FH WARNING : il semble que ces save ne servent a rien
    9595!     save fmc_therm, detrc_therm
    96       real clwcon0(klon,klev)
    97       real zqsat(klon,klev)
    98       real zw_sec(klon,klev+1)
    99       integer lmix_sec(klon)
    100       integer lmax(klon)
    101       real ratqscth(klon,klev)
    102       real ratqsdiff(klon,klev)
    103       real zqsatth(klon,klev) 
     96      REAL clwcon0(klon,klev)
     97      REAL zqsat(klon,klev)
     98      REAL zw_sec(klon,klev+1)
     99      INTEGER lmix_sec(klon)
     100      INTEGER lmax(klon)
     101      REAL ratqscth(klon,klev)
     102      REAL ratqsdiff(klon,klev)
     103      REAL zqsatth(klon,klev)
    104104!nouvelles variables pour la convection
    105       real ale_bl(klon)
    106       real alp_bl(klon)
    107       real ale(klon)
    108       real alp(klon)
     105      REAL ale_bl(klon)
     106      REAL alp_bl(klon)
     107      REAL ale(klon)
     108      REAL alp(klon)
    109109!RC
    110110      !on garde le zmax du pas de temps precedent
    111       real zmax0(klon), f0(klon)
     111      REAL zmax0(klon), f0(klon)
    112112
    113113!!! nrlmd le 10/04/2012
    114       real pbl_tke(klon,klev+1,nbsrf)
    115       real pctsrf(klon,nbsrf)
    116       real omega(klon,klev)
    117       real airephy(klon)
    118       real zlcl_th(klon),fraca0(klon),w0(klon),w_conv(klon)
    119       real therm_tke_max0(klon),env_tke_max0(klon)
    120       real n2(klon),s2(klon),strig(klon)
    121       real ale_bl_stat(klon)
    122       real therm_tke_max(klon,klev),env_tke_max(klon,klev)
    123       real alp_bl_det(klon),alp_bl_fluct_m(klon),alp_bl_fluct_tke(klon),alp_bl_conv(klon),alp_bl_stat(klon)
     114      REAL pbl_tke(klon,klev+1,nbsrf)
     115      REAL pctsrf(klon,nbsrf)
     116      REAL omega(klon,klev)
     117      REAL airephy(klon)
     118      REAL zlcl_th(klon),fraca0(klon),w0(klon),w_conv(klon)
     119      REAL therm_tke_max0(klon),env_tke_max0(klon)
     120      REAL n2(klon),s2(klon),strig(klon)
     121      REAL ale_bl_stat(klon)
     122      REAL therm_tke_max(klon,klev),env_tke_max(klon,klev)
     123      REAL alp_bl_det(klon),alp_bl_fluct_m(klon),alp_bl_fluct_tke(klon),alp_bl_conv(klon),alp_bl_stat(klon)
    124124!!! fin nrlmd le 10/04/2012
    125125
    126126!********************************************************
    127127
    128       real, dimension(klon) :: pcon
    129       real, dimension(klon,klev) :: rhobarz,wth3
    130       integer,dimension(klon) :: lalim
    131       real, dimension(klon,klev+1) :: fm
    132       real, dimension(klon,klev) :: alim_star
    133       real, dimension(klon) :: zmax
     128      REAL, DIMENSION(klon) :: pcon
     129      REAL, DIMENSION(klon,klev) :: rhobarz,wth3
     130      INTEGER,DIMENSION(klon) :: lalim
     131      REAL, DIMENSION(klon,klev+1) :: fm
     132      REAL, DIMENSION(klon,klev) :: alim_star
     133      REAL, DIMENSION(klon) :: zmax
    134134
    135135
    … …  
    140140      REAL d_u_the(klon,klev),d_v_the(klon,klev)
    141141
    142       real zfm_therm(klon,klev+1),zdt
    143       real zentr_therm(klon,klev),zdetr_therm(klon,klev)
     142      REAL zfm_therm(klon,klev+1),zdt
     143      REAL zentr_therm(klon,klev),zdetr_therm(klon,klev)
    144144! FH A VERIFIER : SAVE INUTILES
    145145!      save zentr_therm,zfm_therm
    146146
    147       character (len=20) :: modname='calltherm'
    148       character (len=80) :: abort_message
    149 
    150       integer i,k,isplit
     147      CHARACTER (LEN=20) :: modname='calltherm'
     148      CHARACTER (LEN=80) :: abort_message
     149
     150      INTEGER i,k,isplit
    151151      logical, save :: first=.TRUE.
    152       logical :: new_thermcell
     152      LOGICAL :: new_thermcell
    153153
    154154#ifdef ISO
    155155      REAL xt_seri(ntiso,klon,klev),xtmemoire(ntiso,klon,klev)
    156156      REAL d_xt_ajs(ntiso,klon,klev)
    157       real d_xt_the(ntiso,klon,klev)
     157      REAL d_xt_the(ntiso,klon,klev)
    158158#ifdef DIAGISO
    159       real q_the(klon,klev)
    160       real xt_the(ntiso,klon,klev)
    161 #endif
    162       real qprec(klon,klev)
    163       integer ixt
     159      REAL q_the(klon,klev)
     160      REAL xt_the(ntiso,klon,klev)
     161#endif
     162      REAL qprec(klon,klev)
     163      INTEGER ixt
    164164#endif
    165165
    … …  
    167167!$OMP THREADPRIVATE(first)
    168168!********************************************************
    169       if (first) THEN
     169      IF (first) THEN
    170170        itap=0
    171171        first=.FALSE.
    … …  
    199199         ale_bl(:)=0.
    200200         alp_bl(:)=0.
    201          if (prt_level>=10) THEN
     201         IF (prt_level>=10) THEN
    202202          PRINT*,'thermV4 nsplit: ',nsplit_thermals,' weak_inversion'
    203203         endif
    … …  
    209209            do i=1,klon
    210210! Attention teste abderr 19-03-09
    211 !               logexpr2(i,k)=.not.q_seri(i,k).ge.0.
    212                 logexpr2(i,k)=.not.q_seri(i,k)>=1.e-15
    213                if (logexpr2(i,k)) THEN
     211!               logexpr2(i,k)=.NOT.q_seri(i,k).ge.0.
     212                logexpr2(i,k)=.NOT.q_seri(i,k)>=1.e-15
     213               IF (logexpr2(i,k)) THEN
    214214#ifdef ISO
    215215                qprec(i,k)=q_seri(i,k)
    … …  
    232232
    233233
    234          new_thermcell=iflag_thermals>=15.and.iflag_thermals<=18
    235 #ifdef ISO
    236       if (.not.new_thermcell) THEN
     234         new_thermcell=iflag_thermals>=15.AND.iflag_thermals<=18
     235#ifdef ISO
     236      IF (.NOT.new_thermcell) THEN
    237237           CALL abort_gcm('calltherm 234','isos pas prevus ici',1)
    238238      endif
    239239#ifdef ISOVERIF
    240       if (iso_eau.gt.0) THEN
     240      IF (iso_eau.gt.0) THEN
    241241       CALL iso_verif_egalite_vect2D( &
    242242             xt_seri,q_seri, &
    … …  
    250250         do isplit=1,nsplit_thermals
    251251
    252           if (iflag_thermals>=1000) THEN
     252          IF (iflag_thermals>=1000) THEN
    253253            CALL thermcell_2002(klon,klev,zdt,iflag_thermals   &
    254254        ,pplay,paprs,pphi  &
    … …  
    258258        ,r_aspect_thermals,30.,w2di_thermals  &
    259259        ,tau_thermals)
    260           else if (iflag_thermals==2) THEN
     260          ELSE IF (iflag_thermals==2) THEN
    261261            CALL thermcell_sec(klon,klev,zdt  &
    262262        ,pplay,paprs,pphi,zlev  &
    … …  
    266266        ,r_aspect_thermals,30.,w2di_thermals  &
    267267        ,tau_thermals)
    268           else if (iflag_thermals==3) THEN
     268          ELSE IF (iflag_thermals==3) THEN
    269269            CALL thermcell(klon,klev,zdt  &
    270270        ,pplay,paprs,pphi  &
    … …  
    274274        ,r_aspect_thermals,l_mix_thermals,w2di_thermals  &
    275275        ,tau_thermals)
    276           else if (iflag_thermals==10) THEN
     276          ELSE IF (iflag_thermals==10) THEN
    277277            CALL thermcell_eau(klon,klev,zdt  &
    278278        ,pplay,paprs,pphi  &
    … …  
    282282        ,r_aspect_thermals,l_mix_thermals,w2di_thermals  &
    283283        ,tau_thermals)
    284           else if (iflag_thermals==11) THEN
     284          ELSE IF (iflag_thermals==11) THEN
    285285              abort_message = 'cas non prevu dans calltherm'
    286286              CALL abort_physic (modname,abort_message,1)
    287           else if (iflag_thermals==12) THEN
     287          ELSE IF (iflag_thermals==12) THEN
    288288            CALL calcul_sec(klon,klev,zdt  &
    289289        ,pplay,paprs,pphi,zlev  &
    … …  
    292292        ,r_aspect_thermals,l_mix_thermals,w2di_thermals  &
    293293        ,tau_thermals)
    294           else if (iflag_thermals==13.or.iflag_thermals==14) THEN
     294          ELSE IF (iflag_thermals==13.OR.iflag_thermals==14) THEN
    295295              abort_message = 'thermcellV0_main enleve svn>2084'
    296296              CALL abort_physic (modname,abort_message,1)
    297           else if (new_thermcell) THEN
     297          ELSE IF (new_thermcell) THEN
    298298            CALL thermcell_main(itap,klon,klev,zdt  &
    299299        ,pplay,paprs,pphi,debut  &
    … …  
    324324          )
    325325
    326            if (prt_level>10) WRITE(lunout,*)'Apres thermcell_main OK'
     326           IF (prt_level>10) WRITE(lunout,*)'Apres thermcell_main OK'
    327327         else
    328328           abort_message = 'Cas des thermiques non prevu'
    … …  
    334334! Il aurait mieux valu avoir un nobidouille_stratocu
    335335! Et pour simplifier :
    336 ! nobidouille_stratocu=.not.(iflag_thermals==13.or.iflag_thermals=15)
     336! nobidouille_stratocu=.NOT.(iflag_thermals==13.OR.iflag_thermals=15)
    337337! Ce serait bien de changer, mai en prenant le temps de vérifier que ca
    338338! fait bien ce qu'on croit.
    339339
    340        flag_bidouille_stratocu=iflag_thermals<=12.or.iflag_thermals==14.or.iflag_thermals==16.or.iflag_thermals==18
     340       flag_bidouille_stratocu=iflag_thermals<=12.OR.iflag_thermals==14.OR.iflag_thermals==16.OR.iflag_thermals==18
    341341
    342342! Calcul a posteriori du niveau max des thermiques pour les schémas qui
    343343! ne la sortent pas.
    344       if (iflag_thermals<=12.or.iflag_thermals>=1000) THEN
     344      IF (iflag_thermals<=12.OR.iflag_thermals>=1000) THEN
    345345         lmax(:)=1
    346346         do k=1,klev-1
    … …  
    349349         do k=1,klev-1
    350350            do i=1,klon
    351                if (zfm_therm(i,k+1)>0.) lmax(i)=k
     351               IF (zfm_therm(i,k+1)>0.) lmax(i)=k
    352352            enddo
    353353         enddo
    … …  
    356356      fact(:)=0.
    357357      DO i=1,klon
    358        logexpr1(i)=flag_bidouille_stratocu.or.weak_inversion(i)>0.5
     358       logexpr1(i)=flag_bidouille_stratocu.OR.weak_inversion(i)>0.5
    359359       IF(logexpr1(i)) fact(i)=1./REAL(nsplit_thermals)
    360360      ENDDO
    … …  
    402402#ifdef ISOVERIF
    403403!      WRITE(*,*) 'calltherm 350 tmp: ajout d_xt_the'
    404       if (iso_HDO.gt.0) THEN
     404      IF (iso_HDO.gt.0) THEN
    405405!      i=479
    406406!      k=4
    … …  
    415415#endif
    416416#endif
    417            if (prt_level>10) WRITE(lunout,*)'Apres apres thermcell_main OK'
     417           IF (prt_level>10) WRITE(lunout,*)'Apres apres thermcell_main OK'
    418418
    419419       DO i=1,klon
    … …  
    432432            DO k = 1, klev
    433433            DO i = 1, klon
    434                logexpr2(i,k)=.not.q_seri(i,k)>=0.
    435                if (logexpr2(i,k)) THEN
     434               logexpr2(i,k)=.NOT.q_seri(i,k)>=0.
     435               IF (logexpr2(i,k)) THEN
    436436                q_seri(i,k)=1.e-15
    437437                nbptspb=nbptspb+1
    … …  
    450450#ifdef ISO
    451451#ifdef ISOVERIF
    452       if (iso_HDO.gt.0) THEN
     452      IF (iso_HDO.gt.0) THEN
    453453      CALL iso_verif_aberrant_enc_vect2D( &
    454454          xt_seri,q_seri, &
    … …  
    464464            DO i = 1, klon
    465465               logexpr2(i,k)=t_seri(i,k)<50..or.t_seri(i,k)>370.
    466                if (logexpr2(i,k)) nbptspb=nbptspb+1
    467 !              if ((t_seri(i,k).lt.50.) .or.  &
     466               IF (logexpr2(i,k)) nbptspb=nbptspb+1
     467!              if ((t_seri(i,k).lt.50.) .OR.  &
    468468!    &              (t_seri(i,k).gt.370.)) THEN
    469469!                 PRINT*,'WARN temp apres therm i=',i,'  k=',k  &
    … …  
    483483               do k=1,klev
    484484            do i=1,klon
    485                   if (entr_therm(i,k)>0.) THEN
     485                  IF (entr_therm(i,k)>0.) THEN
    486486                     fmc_therm(i,k+1)=fmc_therm(i,k)+entr_therm(i,k)
    487487                  else
    … …  
    498498!      PRINT*,'<<<<calcul de lhumidite dans thermique'
    499499!CR:on ne le calcule que pour le cas sec
    500       if (iflag_thermals<=11) THEN
     500      IF (iflag_thermals<=11) THEN
    501501      do i=1,klon
    502502         zqasc(i,1)=q_seri(i,1)
    503503         do k=2,klev
    504             if (fmc_therm(i,k+1)>1.e-6) THEN
     504            IF (fmc_therm(i,k+1)>1.e-6) THEN
    505505               zqasc(i,k)=(fmc_therm(i,k)*zqasc(i,k-1)  &
    506506                +entr_therm(i,k)*q_seri(i,k))/fmc_therm(i,k+1)
    … …  
    519519                do k=1,klev
    520520                   clwcon0(i,k)=zqasc(i,k)-zqsat(i,k)
    521                    if (clwcon0(i,k)<0. .or.   &
     521                   IF (clwcon0(i,k)<0. .OR.   &
    522522               (fm_therm(i,k+1)+detrc_therm(i,k))<1.e-6) THEN
    523523                      clwcon0(i,k)=0.
    … …  
    529529                do k=1,klev
    530530                   clwcon0(i,k)=zqla(i,k) 
    531                    if (clwcon0(i,k)<0. .or.   &
     531                   IF (clwcon0(i,k)<0. .OR.   &
    532532               (fm_therm(i,k+1)+detrc_therm(i,k))<1.e-6) THEN
    533533                   clwcon0(i,k)=0.
    … …  
    542542          do i=1,klon
    543543             do k=1,klev
    544                 if (ztla(i,k) < 1.e-10) fraca(i,k) =0.
     544                IF (ztla(i,k) < 1.e-10) fraca(i,k) =0.
    545545             enddo
    546546          enddo
Note: See TracChangeset for help on using the changeset viewer.