Changeset 5099 for LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3_routines.F90

Timestamp:

Jul 22, 2024, 9:29:09 PM (4 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

File:

• LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3_routines.F90 (modified) (50 diffs)

LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3_routines.F90

@@ -57 +57 @@
 !jyg<
 !  noff is chosen such that nl = k_upper so that upmost loops end at about 22 km
-!
+
   noff = min(max(nd-k_upper, 1), (nd+1)/2)
 !!  noff = 1
@@ -1616 +1616 @@
              qnk(i)*(lv0-clmcpv*(tnk(i)-273.15)) + gznk(i)
   END DO
-!
+
 !  Ice fraction
-!
+
   IF (cvflag_ice) THEN
     DO k = minorig, nl
@@ -1686 +1686 @@
   END DO
 !>jyg
-!
 
 ! ***  Find lifted parcel quantities above cloud base    ***
 
 !----------------------------------------------------------------------------
-!
+
   IF (icvflag_Tpa == 2) THEN
 #ifdef ISO
         CALL abort_gcm('cv3_routines 1813','isos pas prevus ici',1)
 #endif
-!
+
 !----------------------------------------------------------------------------
-!
+
     DO k = minorig + 1, nl
       DO i = 1,ncum
@@ -1774 +1773 @@
                   Ux*  (ah0(i) - ahg - ddelta)           /aa
             ENDIF ! (tg .gt. Tx)
-!
+
 !!     print *,' j, k, Um, U, Ux, aa, bb, discr, dd, ddelta ', j, k, Um, U, Ux, aa, bb, discr, dd, ddelta
 !!     print *,' j, k, ah0(i), ahg, tg, qg, tp(i,k), ff ', j, k, ah0(i), ahg, tg, qg, tp(i,k), ff
@@ -1802 +1801 @@
     END DO ! k = minorig + 1, nl
 !----------------------------------------------------------------------------
-!
+
   ELSE IF (icvflag_Tpa == 1) THEN  ! (icvflag_Tpa == 2)
-!
+
 !----------------------------------------------------------------------------
-!
+
 #ifdef ISO
         CALL abort_gcm('cv3_routines 1813','isos pas prevus ici',1)
@@ -1872 +1871 @@
         END IF ! (k>=(icbs(i)+1))
       END DO ! i = 1, ncum
-!
+
       IF (cvflag_prec_eject) THEN
 #ifdef ISO
@@ -1898 +1897 @@
 !   ejection.
 !  =====================================================================================
-!  
+
 !   Verif
             qpreca(i,k) = ejectliq*qpl(i,k) + ejectice*qps(i,k)                                   !!jygprl
@@ -1904 +1903 @@
             frac_s(i,k) = (1.-ejectliq)*frac(i,k) + &                                             !!jygprl
                ejectliq*(1. - (qpl(i,k)+(1.-frac(i,k))*qcld(i,k))/max(clw(i,k),smallestreal))     !!jygprl
-!          
+
             denomm1 = 1./(1. - qpreca(i,k))
-!          
+
             qta(i,k) = qta(i,k-1) - &
                       qpreca(i,k)*(1.-qta(i,k-1))*denomm1
@@ -1925 +1924 @@
         END DO ! i = 1, ncum
       ENDIF  ! (cvflag_prec_eject)
-! 
+
     END DO ! k = minorig + 1, nl
-!
+
 !----------------------------------------------------------------------------
-!
+
   ELSE IF (icvflag_Tpa == 0) THEN! (icvflag_Tpa == 2) ELSE IF(icvflag_Tpa == 1)
-!
+
 !----------------------------------------------------------------------------
-!
+
   DO k = minorig + 1, nl
     DO i = 1, ncum
@@ -2160 +2159 @@
 
 !----------------------------------------------------------------------------
-!
+
   ENDIF ! (icvflag_Tpa == 2) ELSEIF (icvflag_Tpa == 1) ELSE (icvflag_Tpa == 0)
 #ifdef ISOVERIF
@@ -2170 +2169 @@
   enddo
 #endif
-!
+
 !----------------------------------------------------------------------------
-!
+
 ! =====================================================================
 ! --- SET THE PRECIPITATION EFFICIENCIES 
 ! --- THESE MAY BE FUNCTIONS OF TP(I), P(I) AND CLW(I)
 ! =====================================================================
-!
+
   IF (flag_epkeorig/=1) THEN
     DO k = 1, nl ! convect3
@@ -2213 +2212 @@
     END DO
   END IF
-!
+
 !   =========================================================================
   IF (prt_level >= 10) THEN
@@ -2219 +2218 @@
                           (k, tp(1,k), tvp(1,k), k = 1,nl)
   ENDIF
-!
+
 ! =====================================================================
 ! --- CALCULATE VIRTUAL TEMPERATURE AND LIFTED PARCEL
@@ -2451 +2450 @@
 
 !jyg : cvflag_ice test outside the loops (07042015)
-!
+
   IF (cvflag_ice) THEN
-!
+
   IF (cvflag_prec_eject) THEN
 !!    DO k = minorig + 1, nl
@@ -2485 +2484 @@
       END DO
     END DO
-!
+
   ELSE   ! (cvflag_ice)
-!
+
     DO k = minorig + 1, nl
       DO i = 1, ncum
@@ -2501 +2500 @@
       END DO
     END DO
-!
+
   END IF  ! (cvflag_ice)
 
@@ -2514 +2513 @@
 ! ===================================================================
 ! ---  CLOSURE OF CONVECT3
-!
+
 ! vectorization: S. Bony
 ! ===================================================================
@@ -3820 +3819 @@
   END DO
 
-!
 ! Get adiabatic ascent mass flux 
-!
+
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   IF (adiab_ascent_mass_flux_depends_on_ejectliq) THEN
@@ -3857 +3855 @@
 
 ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-!
+
 ! ***                    begin downdraft loop                    ***
-!
+
 ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
@@ -3878 +3876 @@
 ! ***  integrate liquid water equation to find condensed water   ***
 ! ***                and condensed water flux                    ***
-!
-!
+
+
 ! ***              calculate detrained precipitation             ***
 
@@ -4088 +4086 @@
         bfac = 1./(sigd(il)*wt(il,i))
 
-!
     IF (prt_level >= 20) THEN
       Print*, 'cv3_unsat after provisional rp estimate: rp, afac, bfac ', &
           i, rp(1, i), afac,bfac
     ENDIF
-!
+
 !JYG1
 ! cc        sigt=1.0
@@ -4171 +4168 @@
           evap(il, i) = (wdtrain(il)+sigd(il)*wt(il,i)*(prec(il,i+1)-prec(il,i))) / &
                         (sigd(il)*(ph(il,i)-ph(il,i+1))*100.)
-!
+
     IF (prt_level >= 20) THEN
       Print*, 'cv3_unsat after evap computation: wdtrain, sigd, wt, prec(i+1),prec(i) ', &
           i, wdtrain(1), sigd(1), wt(1,i), prec(1,i+1),prec(1,i)
     ENDIF
-!
 
 !jyg<
@@ -4403 +4399 @@
     END DO
 ! ----------------------------------------------------------------
-!
+
     IF (prt_level >= 20) THEN
       Print*, 'cv3_unsat after mp computation: mp, b(i), b(i-1) ', &
           i, mp(1, i), b(1,i), b(1,max(i-1,1))
     ENDIF
-!
 
 ! ***       find mixing ratio of precipitating downdraft     ***
@@ -4766 +4761 @@
       REAL, DIMENSION (ntraciso,nloc, na), INTENT (IN)            :: xtice
 #endif
-!
+
 !input/output:
       REAL, DIMENSION (nloc, na), INTENT (INOUT)         :: m, mp
@@ -4773 +4768 @@
       REAL, DIMENSION (nloc, nd), INTENT (INOUT)         :: sig
       REAL, DIMENSION (nloc), INTENT (INOUT)             :: sigd
-!
+
 !outputs:
       REAL, DIMENSION (nloc), INTENT (OUT)               :: precip
@@ -4794 +4789 @@
       real, DIMENSION (ntraciso,nloc, nd+1), INTENT (OUT) :: xtVprecip, xtVprecipi
 #endif
-!
+
 !local variables:
       INTEGER                                            :: i, k, il, n, j, num1
@@ -4863 +4858 @@
 #endif
 #endif
-! 
+
 ! -------------------------------------------------------------
 
@@ -5134 +5129 @@
   ENDIF ! (adiab_ascent_mass_flux_depends_on_ejectliq) ELSE
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!
+
 !    print*,'cv3_yield avant ft'
 ! am is the part of cbmf taken from the first level
@@ -5408 +5403 @@
            IF (ok_optim_yield) THEN                       !|
 !-----------------------------------------------------------
-!
+
 !***                                                      ***
 !***    Compute convective mass fluxes upwd and dnwd      ***
 
-!
 ! =================================================
 !              upward fluxes                      |
 ! ------------------------------------------------
-!
+
 upwd(:,:) = 0.
 up_to(:,:) = 0.
 up_from(:,:) = 0.
-!
+
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   IF (adiab_ascent_mass_flux_depends_on_ejectliq) THEN
@@ -5428 +5422 @@
 !! WARNING : in the present version, taking into account the mass-flux decrease due to 
 !! precipitation ejection leads to water conservation violation.
-!
+
 ! - Upward mass flux of mixed draughts
 !---------------------------------------
@@ -5440 +5434 @@
   ENDDO
 ENDDO
-!
+
 DO j = 3, nl
   DO i = 2, j-1
@@ -5450 +5444 @@
   ENDDO
 ENDDO
-!
+
 ! The difference between upwd(il,i) and upwd(il,i-1) is due to updrafts ending in layer 
 !(i-1) (theses drafts cross interface (i-1) but not interface(i)) and to updrafts starting 
 !from layer (i-1) (theses drafts cross interface (i) but not interface(i-1)): 
-! 
+
 DO i = 2, nlp
   DO il = 1, ncum
@@ -5462 +5456 @@
   ENDDO
 ENDDO
-!
+
 ! - Total upward mass flux
 !---------------------------
@@ -5477 +5471 @@
 !! The decrease of the adiabatic ascent mass flux due to ejection of precipitation 
 !! is not taken into account. 
-!
+
 ! - Upward mass flux
 !-------------------
@@ -5494 +5488 @@
   ENDDO
 ENDDO
-!
+
 DO i = 1, nl
   DO il = 1, ncum
@@ -5502 +5496 @@
   ENDDO
 ENDDO
-!
+
 DO j = 3, nl
   DO i = 2, j-1
@@ -5512 +5506 @@
   ENDDO
 ENDDO
-!
+
 ! The difference between upwd(il,i) and upwd(il,i-1) is due to updrafts ending in layer 
 !(i-1) (theses drafts cross interface (i-1) but not interface(i)) and to updrafts starting 
 !from layer (i-1) (theses drafts cross interface (i) but not interface(i-1)): 
-! 
+
 DO i = 2, nlp
   DO il = 1, ncum
@@ -5529 +5523 @@
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-!
 ! =================================================
 !              downward fluxes                    |
@@ -5546 +5539 @@
   ENDDO
 ENDDO
-!
+
 DO j = 1, nl
   DO i = j+1, nl
@@ -5557 +5550 @@
   ENDDO
 ENDDO
-!
+
 ! The difference between dnwd(il,i) and dnwd(il,i+1) is due to downdrafts ending in layer 
 !(i) (theses drafts cross interface (i+1) but not interface(i)) and to downdrafts 
 !starting from layer (i) (theses drafts cross interface (i) but not interface(i+1)): 
-!
+
 DO i = nl-1, 1, -1
   DO il = 1, ncum
@@ -5569 +5562 @@
 ENDDO
 ! =================================================
-!
+
 !-----------------------------------------------------------
         ENDIF !(ok_optim_yield)                           !|
@@ -5593 +5586 @@
     IF (num1<=0) GO TO 500
 
-!
 !jyg<
 !-----------------------------------------------------------
@@ -5651 +5643 @@
       END DO
     END DO
-!
+
 !-----------------------------------------------------------
         ENDIF !(ok_optim_yield)                           !|
 !-----------------------------------------------------------
-!
+
 !!   print *,'yield, i, amp1, ad', i, amp1(1), ad(1)
 
@@ -5712 +5704 @@
                                     t(il,i)*(cpv-cpd)*(rr(il,i)-qent(il,i,i)))*cpinv
         END IF
-!
+
 ! sb: on ne fait pas encore la correction permettant de mieux
 ! conserver l'eau:
@@ -5848 +5840 @@
         ! ajout du terme des ddfts sensi stricto
 !        write(*,*) 'tmp cv3_yield 4165: i,il=',i,il
-!
+
         if (option_traceurs.eq.6) then
           do iiso = 1, niso
@@ -6153 +6145 @@
             ft(il, i) = ft(il, i) + 0.01*grav*dpinv*ment(il, k, i) * &
                  (hent(il,k,i)-h(il,i)+t(il,i)*(cpv-cpd)*(rr(il,i)+awat(il)-qent(il,k,i)))*cpinv
-!
+
 #ifdef ISO
         ! on change le traitement de cette ligne le 8 mai 2009:
@@ -6192 +6184 @@
        ! end cam verif 
 #endif
-!
+
           END IF ! i
         END DO
@@ -6814 +6806 @@
     END IF
   END DO
-!
+
     IF (prt_level >= 5) THEN
       print *,' CV3_YIELD : alpha_qpos ',alpha_qpos(1)
     ENDIF
 
-!
   DO il = 1, ncum
     IF (iflag(il)<=1) THEN
@@ -7303 +7294 @@
   REAL, DIMENSION (len, na, na), INTENT (OUT)        :: phi, phi2, epmlmMm
   REAL, DIMENSION (len, na), INTENT (OUT)            :: da, d1a, dam, eplaMm
-!
+
 ! variables pour tracer dans precip de l'AA et des mel
 !local variables:
@@ -7600 +7591 @@
 !AC! 2110    continue
 !AC! 2100   continue
-!
+
   RETURN
 END SUBROUTINE cv3_uncompress