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

Timestamp:

Aug 2, 2024, 2:12:03 PM (3 months ago)

Author:

abarral

Message:

Add missing klon on strataer_emiss_mod.F90
Correct various missing explicit declarations
Replace tabs by spaces (tabs are not part of the fortran charset)
Continue cleaning modules
Removed unused arguments and variables

File:

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

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

@@ -2 +2 @@
   PRIVATE  ! -- We'd love to put IMPLICIT NONE;  here...
   PUBLIC get_uvd, copie, get_uvd2, rdgrads, spaces
+
+  REAL play(100)  !pression en Pa au milieu de chaque couche GCM
+  INTEGER JM(100) !pression en Pa au milieu de chaque couche GCM
+  REAL coef1(100) !coefficient d interpolation
+  REAL coef2(100) !coefficient d interpolation
+  INTEGER klev
+
+  INTEGER nblvlm !nombre de niveau de pression du mesoNH
+  REAL playm(100)  !pression en Pa au milieu de chaque couche Meso-NH
+  REAL hplaym(100) !pression en hPa milieux des couches Meso-NH
+
+
 CONTAINS
 
@@ -16 +28 @@
     ! pouvoir calculer la convergence et le cisaillement dans la physiq
     !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-
-    INTEGER klev
-    REAL play(100)  !pression en Pa au milieu de chaque couche GCM
-    INTEGER JM(100) !pression en Pa au milieu de chaque couche GCM
-    REAL coef1(100) !coefficient d interpolation
-    REAL coef2(100) !coefficient d interpolation
-
-    INTEGER nblvlm !nombre de niveau de pression du mesoNH
-    REAL playm(100)  !pression en Pa au milieu de chaque couche Meso-NH
-    REAL hplaym(100) !pression en hPa milieux des couches Meso-NH
-
     INTEGER i, j, k, ll, in
-
     CHARACTER*80 file_forctl, file_fordat
-
-    COMMON/com1_phys_gcss/play, coef1, coef2, JM, klev
-    COMMON/com2_phys_gcss/playm, hplaym, nblvlm
 
     !======================================================================
@@ -162 +159 @@
     !*** precedent en format gcm                                     ***
     IF(pas>pasprev)THEN
-      do i = 1, klev
+      DO i = 1, klev
         htbef(i) = htaft(i)
         hqbef(i) = hqaft(i)
@@ -192 +189 @@
       IF(Tp_fcg) THEN
         !     (le forcage est donne en temperature potentielle)
-        do i = 1, nblvlm
+        DO i = 1, nblvlm
           ht_mes(i) = ht_mes(i) * (hplaym(i) / 1000.)**rkappa
         enddo
       endif ! Tp_fcg
       IF(Turb_fcg) THEN
-        do i = 1, nblvlm
+        DO i = 1, nblvlm
           hThTurb_mes(i) = hThTurb_mes(i) * (hplaym(i) / 1000.)**rkappa
         enddo
@@ -216 +213 @@
       !*** on interpole les champs meso_NH sur les niveaux de pression***
       !*** gcm . on obtient le nouveau champ after                    ***
-      do k = 1, klev
+      DO k = 1, klev
         IF (JM(k) == 0) THEN
           htaft(k) = ht_mes(jm(k) + 1)
@@ -254 +251 @@
     !*** on conserve les derniers champs calcules                    ***
     IF(temps>=pasmax)THEN
-      do ll = 1, klev
+      DO ll = 1, klev
         ht(ll) = htaft(ll)
         hq(ll) = hqaft(ll)
@@ -267 +264 @@
       !*** on interpole sur les pas de temps de 10mn du gcm a partir   ***
       !** des pas de temps de 1h du meso_NH                            ***
-      do j = 1, klev
+      DO j = 1, klev
         ht(j) = ((timeaft - time) * htbef(j) + (time - timebef) * htaft(j)) / dt
         hq(j) = ((timeaft - time) * hqbef(j) + (time - timebef) * hqaft(j)) / dt
@@ -287 +284 @@
     print *, ' time,timebef,timeaft', time, timebef, timeaft
     print *, ' ht,htbef,htaft,hthturb,hthturbbef,hthturbaft'
-    do j = 1, klev
+    DO j = 1, klev
       print *, j, ht(j), htbef(j), htaft(j), &
               &             hthturb(j), hthturbbef(j), hthturbaft(j)
     enddo
     print *, ' hq,hqbef,hqaft,hqturb,hqturbbef,hqturbaft'
-    do j = 1, klev
+    DO j = 1, klev
       print *, j, hq(j), hqbef(j), hqaft(j), &
               &             hqturb(j), hqturbbef(j), hqturbaft(j)
@@ -317 +314 @@
 
     !------------------
-    do i = 1, 1000
+    DO i = 1, 1000
       read(97, 1000, end = 999) string
       1000 format (a4)
@@ -373 +370 @@
     !------------------------------------------------------------------------
     IF(Tp_fcg) THEN
-      do i = 1, nblvlm
+      DO i = 1, nblvlm
         ht_mes(i) = ht_mes(i) * (hplaym(i) / 1000.)**rkappa
       enddo
@@ -393 +390 @@
     ! on interpole sur les niveaux du gcm(niveau pression bien sur!)
     !-----------------------------------------------------------------------
-    do k = 1, klev
+    DO k = 1, klev
       IF (JM(k) == 0) THEN
         !FKC bug? ne faut il pas convertir tsol en tendance ????
@@ -426 +423 @@
     tsaft = ts_subr
     ! valeurs initiales des champs de convergence
-    do k = 1, klev
+    DO k = 1, klev
       ht(k) = htaft(k)
       hq(k) = hqaft(k)
@@ -473 +470 @@
     data alx, aly /100000., 150000./
 
-    do k = 1, klev
+    DO k = 1, klev
       du = abs(vu_f(k) - cx) / alx
       dv = abs(vv_f(k) - cy) / aly
@@ -489 +486 @@
     IMPLICIT NONE
 
-    !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-    ! cette routine remplit les COMMON com1_phys_gcss et com2_phys_gcss.h
-    !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-
-    INTEGER klev !nombre de niveau de pression du GCM
-    REAL play(100)  !pression en Pa au milieu de chaque couche GCM
-    INTEGER JM(100)
-    REAL coef1(100)   !coefficient d interpolation
-    REAL coef2(100)   !coefficient d interpolation
-
-    INTEGER nblvlm !nombre de niveau de pression du mesoNH
-    REAL playm(100) !pression en Pa au milieu de chaque couche Meso-NH
-    REAL hplaym(100)!pression en hecto-Pa des milieux de couche Meso-NH
-
-    COMMON/com1_phys_gcss/play, coef1, coef2, JM, klev
-    COMMON/com2_phys_gcss/playm, hplaym, nblvlm
-
     INTEGER k, klevgcm
     REAL playgcm(klevgcm) ! pression en milieu de couche du gcm
@@ -518 +498 @@
     !---------------------------------------------------------------------
 
-    do k = 1, klev
+    DO k = 1, klev
       play(k) = playgcm(k)
       PRINT*, 'la pression gcm est:', play(k)
@@ -526 +506 @@
     ! lecture du descripteur des donnees Meso-NH (forcing.ctl):
     !  -> nb niveaux du meso.NH (nblvlm) + pressions meso.NH
-    ! (on remplit le COMMON com2_phys_gcss)
     !----------------------------------------------------------------------
 
@@ -536 +515 @@
     ! etude de la correspondance entre les niveaux meso.NH et GCM;
     ! calcul des coefficients d interpolation coef1 et coef2
-    ! (on remplit le COMMON com1_phys_gcss)
     !----------------------------------------------------------------------
 
@@ -549 +527 @@
     WRITE(*, *) '--------------------------------------'
     WRITE(*, *) 'GCM: nb niveaux:', klev, ' et pression, coeffs:'
-    do k = 1, klev
+    DO k = 1, klev
       WRITE(*, *) play(k), coef1(k), coef2(k)
     enddo
     WRITE(*, *) 'MESO-NH: nb niveaux:', nblvlm, ' et pression:'
-    do k = 1, nblvlm
+    DO k = 1, nblvlm
       WRITE(*, *) playm(k), hplaym(k)
     enddo
@@ -570 +548 @@
     !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
 
-    INTEGER nblvlm !nombre de niveau de pression du mesoNH
-    REAL playm(100)  !pression en Pa milieu de chaque couche Meso-NH
-    REAL hplaym(100) !pression en hPa des milieux de couche Meso-NH
-    COMMON/com2_phys_gcss/playm, hplaym, nblvlm
-
     INTEGER i, lu, mlz, mlzh
 
@@ -586 +559 @@
     open(lu, file = file_forctl, form = 'formatted')
 
-    do i = 1, 1000
+    DO i = 1, 1000
       read(lu, 1000, end = 999) a
       IF (a == 'ZDEF') go to 100
@@ -608 +581 @@
     !      Si la pression est en HPa, la multiplier par 100
     IF (playm(1) < 10000.) THEN
-      do mlz = 1, nblvlm
+      DO mlz = 1, nblvlm
         playm(mlz) = playm(mlz) * 100.
       enddo
@@ -617 +590 @@
 
     PRINT*, ' '
-    do mlzh = 1, nblvlm
+    DO mlzh = 1, nblvlm
       hplaym(mlzh) = playm(mlzh) / 100.
     enddo
@@ -644 +617 @@
     icomp = icount
 
-    do k = 1, nl
+    DO k = 1, nl
       icomp = icomp + 1
       read(itape, rec = icomp)z(k)
       print *, 'icomp,k,z(k) ', icomp, k, z(k)
     enddo
-    do k = 1, nl
+    DO k = 1, nl
       icomp = icomp + 1
       read(itape, rec = icomp)hT(k)
       PRINT*, hT(k), k
     enddo
-    do k = 1, nl
+    DO k = 1, nl
       icomp = icomp + 1
       read(itape, rec = icomp)hQ(k)
@@ -660 +633 @@
 
     IF(turb_fcg) THEN
-      do k = 1, nl
+      DO k = 1, nl
         icomp = icomp + 1
         read(itape, rec = icomp)hThTur(k)
       enddo
-      do k = 1, nl
+      DO k = 1, nl
         icomp = icomp + 1
         read(itape, rec = icomp)hqTur(k)
@@ -672 +645 @@
 
     IF(imp_fcg) THEN
-      do k = 1, nl
+      DO k = 1, nl
         icomp = icomp + 1
         read(itape, rec = icomp)hu(k)
       enddo
-      do k = 1, nl
+      DO k = 1, nl
         icomp = icomp + 1
         read(itape, rec = icomp)hv(k)
@@ -683 +656 @@
     endif
 
-    do k = 1, nl
+    DO k = 1, nl
       icomp = icomp + 1
       read(itape, rec = icomp)hw(k)
@@ -707 +680 @@
     !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
 
-    INTEGER klev    !nombre de niveau de pression du GCM
-    REAL play(100)  !pression en Pa au milieu de chaque couche GCM
-    INTEGER JM(100)
-    REAL coef1(100) !coefficient d interpolation
-    REAL coef2(100) !coefficient d interpolation
-
-    INTEGER nblvlm !nombre de niveau de pression du mesoNH
-    REAL playm(100) !pression en Pa milieu de chaque couche Meso-NH
-    REAL hplaym(100)!pression en hPa des milieux de couche Meso-NH
-
-    COMMON/com1_phys_gcss/play, coef1, coef2, JM, klev
-    COMMON/com2_phys_gcss/playm, hplaym, nblvlm
-
     REAL psol
     REAL val
     INTEGER k, mlz
 
-    do k = 1, klev
+    DO k = 1, klev
       val = play(k)
       IF (val > playm(1)) THEN
@@ -732 +692 @@
         coef2(1) = (val - psol) / (playm(mlz + 1) - psol)
       ELSE IF (val > playm(nblvlm)) THEN
-        do mlz = 1, nblvlm
+        DO mlz = 1, nblvlm
           IF (val <= playm(mlz).AND. val > playm(mlz + 1))THEN
             JM(k) = mlz