Changeset 5117 for LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_old_1dconv.f90

Timestamp:

Jul 24, 2024, 4:23:34 PM (3 months ago)

Author:

abarral

Message:

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

File:

• LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_old_1dconv.f90 (modified) (21 diffs)

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

@@ -27 +27 @@
     REAL hplaym(100) !pression en hPa milieux des couches Meso-NH
 
-    integer i, j, k, ll, in
+    INTEGER i, j, k, ll, in
 
     CHARACTER*80 file_forctl, file_fordat
@@ -45 +45 @@
     !       dt         :pas de temps du meso_NH (en secondes)
     !----------------------------------------------------------------------
-    integer pasmax, dt
+    INTEGER pasmax, dt
     save pasmax, dt
     !----------------------------------------------------------------------
@@ -60 +60 @@
     !           hv     : idem le long de y.
     !           Ts     : Temperature de surface (K)
-    !           imp_fcg: var. logical .eq. T si forcage en impulsion
-    !           ts_fcg: var. logical .eq. T si forcage en Ts present dans fichier
-    !           Tp_fcg: var. logical .eq. T si forcage donne en Temp potentielle
-    !           Turb_fcg: var. logical .eq. T si forcage turbulent present dans fichier
-    !----------------------------------------------------------------------
-    integer itap
-    real dtime
-    real ht(100)
-    real hq(100)
-    real hu(100)
-    real hv(100)
-    real hw(100)
-    real hthturb(100)
-    real hqturb(100)
-    real Ts, Ts_subr
-    logical imp_fcg
-    logical ts_fcg
-    logical Tp_fcg
-    logical Turb_fcg
+    !           imp_fcg: var. LOGICAL .EQ. T si forcage en impulsion
+    !           ts_fcg: var. LOGICAL .EQ. T si forcage en Ts present dans fichier
+    !           Tp_fcg: var. LOGICAL .EQ. T si forcage donne en Temp potentielle
+    !           Turb_fcg: var. LOGICAL .EQ. T si forcage turbulent present dans fichier
+    !----------------------------------------------------------------------
+    INTEGER itap
+    REAL dtime
+    REAL ht(100)
+    REAL hq(100)
+    REAL hu(100)
+    REAL hv(100)
+    REAL hw(100)
+    REAL hthturb(100)
+    REAL hqturb(100)
+    REAL Ts, Ts_subr
+    LOGICAL imp_fcg
+    LOGICAL ts_fcg
+    LOGICAL Tp_fcg
+    LOGICAL Turb_fcg
     !----------------------------------------------------------------------
     ! Variables internes de get_uvd (note : l interpolation temporelle
@@ -100 +100 @@
     !     tsbef     : surface temperature 'before time step'
     !----------------------------------------------------------------------
-    integer time0, pas, pasprev
+    INTEGER time0, pas, pasprev
     save time0, pas, pasprev
-    real time
-    real htaft(100), hqaft(100), hwaft(100), huaft(100), hvaft(100)
-    real hthturbaft(100), hqturbaft(100)
-    real Tsaft
+    REAL time
+    REAL htaft(100), hqaft(100), hwaft(100), huaft(100), hvaft(100)
+    REAL hthturbaft(100), hqturbaft(100)
+    REAL Tsaft
     save htaft, hqaft, hwaft, huaft, hvaft, hthturbaft, hqturbaft
-    real htbef(100), hqbef(100), hwbef(100), hubef(100), hvbef(100)
-    real hthturbbef(100), hqturbbef(100)
-    real Tsbef
+    REAL htbef(100), hqbef(100), hwbef(100), hubef(100), hvbef(100)
+    REAL hthturbbef(100), hqturbbef(100)
+    REAL Tsbef
     save htbef, hqbef, hwbef, hubef, hvbef, hthturbbef, hqturbbef
 
-    real timeaft, timebef
+    REAL timeaft, timebef
     save timeaft, timebef
-    integer temps
+    INTEGER temps
     character*4 string
     !----------------------------------------------------------------------
     ! variables arguments de la subroutine rdgrads
     !---------------------------------------------------------------------
-    integer icompt, icomp1 !compteurs de rdgrads
-    real z(100)         ! altitude (grille Meso)
-    real ht_mes(100)    !convergence horizontale de temperature
+    INTEGER icompt, icomp1 !compteurs de rdgrads
+    REAL z(100)         ! altitude (grille Meso)
+    REAL ht_mes(100)    !convergence horizontale de temperature
     !-(grille Meso)
-    real hq_mes(100)    !convergence horizontale d humidite
+    REAL hq_mes(100)    !convergence horizontale d humidite
     !(grille Meso)
-    real hw_mes(100)    !vitesse verticale moyenne
+    REAL hw_mes(100)    !vitesse verticale moyenne
     !(grille Meso)
-    real hu_mes(100), hv_mes(100)    !convergence horizontale d impulsion
+    REAL hu_mes(100), hv_mes(100)    !convergence horizontale d impulsion
     !(grille Meso)
-    real hthturb_mes(100) !tendance horizontale de T_pot, due aux
+    REAL hthturb_mes(100) !tendance horizontale de T_pot, due aux
     !flux turbulents
-    real hqturb_mes(100) !tendance horizontale d humidite, due aux
+    REAL hqturb_mes(100) !tendance horizontale d humidite, due aux
     !flux turbulents
 
@@ -143 +143 @@
     !---------------------------------------------------------------------
     character*80 aaa, atemps, spaces, apasmax
-    integer nch, imn, ipa
+    INTEGER nch, imn, ipa
     !---------------------------------------------------------------------
     !  procedures appelees
@@ -220 +220 @@
       !*** gcm . on obtient le nouveau champ after                    ***
       do k = 1, klev
-        if (JM(k) == 0) THEN
+        IF (JM(k) == 0) THEN
           htaft(k) = ht_mes(jm(k) + 1)
           hqaft(k) = hq_mes(jm(k) + 1)
@@ -232 +232 @@
             hqTurbaft(k) = hqTurb_mes(jm(k) + 1)
           endif ! Turb_fcg
-        else ! JM(k) .eq. 0
+        else ! JM(k) .EQ. 0
           htaft(k) = coef1(k) * ht_mes(jm(k)) + coef2(k) * ht_mes(jm(k) + 1)
           hqaft(k) = coef1(k) * hq_mes(jm(k)) + coef2(k) * hq_mes(jm(k) + 1)
@@ -246 +246 @@
                     & + coef2(k) * hqTurb_mes(jm(k) + 1)
           endif ! Turb_fcg
-        endif ! JM(k) .eq. 0
+        endif ! JM(k) .EQ. 0
       enddo
       tsaft = ts_subr
@@ -323 +323 @@
       read(97, 1000, end = 999) string
       1000 format (a4)
-      if (string == 'TDEF') go to 50
+      IF (string == 'TDEF') go to 50
     enddo
     50   backspace(97)
@@ -397 +397 @@
     !-----------------------------------------------------------------------
     do k = 1, klev
-      if (JM(k) == 0) THEN
+      IF (JM(k) == 0) THEN
         !FKC bug? ne faut il pas convertir tsol en tendance ????
         !RT bug taken care of by removing the stuff
@@ -411 +411 @@
           hqTurbaft(k) = hqTurb_mes(jm(k) + 1)
         endif ! Turb_fcg
-      else ! JM(k) .eq. 0
+      else ! JM(k) .EQ. 0
         htaft(k) = coef1(k) * ht_mes(jm(k)) + coef2(k) * ht_mes(jm(k) + 1)
         hqaft(k) = coef1(k) * hq_mes(jm(k)) + coef2(k) * hq_mes(jm(k) + 1)
@@ -425 +425 @@
                   & + coef2(k) * hqTurb_mes(jm(k) + 1)
         endif ! Turb_fcg
-      endif ! JM(k) .eq. 0
+      endif ! JM(k) .EQ. 0
     enddo
     tsaft = ts_subr
@@ -457 +457 @@
   SUBROUTINE advect_tvl(dtime, zt, zq, vu_f, vv_f, t_f, q_f                   &
           &, d_t_adv, d_q_adv)
-    use dimphy
+    USE dimphy
     IMPLICIT NONE
 
@@ -463 +463 @@
     !cccc      INCLUDE "dimphy.h"
 
-    integer k
-    real dtime, fact, du, dv, cx, cy, alx, aly
-    real zt(klev), zq(klev, 3)
-    real vu_f(klev), vv_f(klev), t_f(klev), q_f(klev, 3)
-
-    real d_t_adv(klev), d_q_adv(klev, 3)
+    INTEGER k
+    REAL dtime, fact, du, dv, cx, cy, alx, aly
+    REAL zt(klev), zq(klev, 3)
+    REAL vu_f(klev), vv_f(klev), t_f(klev), q_f(klev, 3)
+
+    REAL d_t_adv(klev), d_q_adv(klev, 3)
 
     ! Velocity of moving cell
@@ -509 +509 @@
     COMMON/com2_phys_gcss/playm, hplaym, nblvlm
 
-    integer k, klevgcm
-    real playgcm(klevgcm) ! pression en milieu de couche du gcm
-    real psolgcm
+    INTEGER k, klevgcm
+    REAL playgcm(klevgcm) ! pression en milieu de couche du gcm
+    REAL psolgcm
     character*80 file_forctl
 
@@ -584 +584 @@
     character*4 a
     character*80 aaa, anblvl, spaces
-    integer nch
+    INTEGER nch
 
     lu = 9
@@ -591 +591 @@
     do i = 1, 1000
       read(lu, 1000, end = 999) a
-      if (a == 'ZDEF') go to 100
+      IF (a == 'ZDEF') go to 100
     enddo
 
@@ -610 +610 @@
     read(lu, *) (playm(mlz), mlz = 1, nblvlm)
     !      Si la pression est en HPa, la multiplier par 100
-    if (playm(1) < 10000.) THEN
+    IF (playm(1) < 10000.) THEN
       do mlz = 1, nblvlm
         playm(mlz) = playm(mlz) * 100.
@@ -637 +637 @@
     IMPLICIT none
     INTEGER itape, icount, icomp, nl
-    real z(nl), ht(nl), hq(nl), hw(nl), hu(nl), hv(nl)
-    real hthtur(nl), hqtur(nl)
-    real ts
+    REAL z(nl), ht(nl), hq(nl), hw(nl), hu(nl), hv(nl)
+    REAL hthtur(nl), hqtur(nl)
+    REAL ts
 
     INTEGER k
@@ -729 +729 @@
     do k = 1, klev
       val = play(k)
-      if (val > playm(1)) THEN
+      IF (val > playm(1)) THEN
         mlz = 0
         JM(1) = mlz
         coef1(1) = (playm(mlz + 1) - val) / (playm(mlz + 1) - psol)
         coef2(1) = (val - psol) / (playm(mlz + 1) - psol)
-      else if (val > playm(nblvlm)) THEN
+      ELSE IF (val > playm(nblvlm)) THEN
         do mlz = 1, nblvlm
-          if (val <= playm(mlz).and. val > playm(mlz + 1))THEN
+          IF (val <= playm(mlz).AND. val > playm(mlz + 1))THEN
             JM(k) = mlz
             coef1(k) = (playm(mlz + 1) - val) / (playm(mlz + 1) - playm(mlz))
@@ -807 +807 @@
         IF(END==BEG - 2) END = LENGTH
         !*        PRINT *,'NTH,LENGTH,N,BEG,END=',NTH,LENGTH,N,BEG,END
-      end do
+      end DO
       NCH = END - BEG + 1
       IF(NCH>0) SST = STR(BEG:END)