Ignore:
Timestamp:
Nov 5, 2018, 3:24:59 PM (6 years ago)
Author:
Laurent Fairhead
Message:

Undoing merge with trunk (r3356) to properly register Yann's latest modifications

Location:
LMDZ6/branches/DYNAMICO-conv
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/DYNAMICO-conv

  • LMDZ6/branches/DYNAMICO-conv/libf/phylmd/newmicro.F90

    r3356 r3411  
    11! $Id$
    22
    3 SUBROUTINE newmicro(flag_aerosol, ok_cdnc, bl95_b0, bl95_b1, paprs, pplay, t, pqlwp, pclc, &
     3
     4
     5SUBROUTINE newmicro(ok_cdnc, bl95_b0, bl95_b1, paprs, pplay, t, pqlwp, pclc, &
    46    pcltau, pclemi, pch, pcl, pcm, pct, pctlwp, xflwp, xfiwp, xflwc, xfiwc, &
    57    mass_solu_aero, mass_solu_aero_pi, pcldtaupi, re, fl, reliq, reice, &
    … …  
    810  USE dimphy
    911  USE phys_local_var_mod, ONLY: scdnc, cldncl, reffclwtop, lcc, reffclws, &
    10       reffclwc, cldnvi, lcc3d, lcc3dcon, lcc3dstra, icc3dcon, icc3dstra,  &
    11       zfice, dNovrN
     12    reffclwc, cldnvi, lcc3d, lcc3dcon, lcc3dstra
    1213  USE phys_state_var_mod, ONLY: rnebcon, clwcon
    1314  USE icefrac_lsc_mod ! computes ice fraction (JBM 3/14)
    14   USE ioipsl_getin_p_mod, ONLY : getin_p
    15   USE print_control_mod, ONLY: lunout
    16 
    17 
    1815  IMPLICIT NONE
    1916  ! ======================================================================
    … …  
    142139  ! within the grid cell)
    143140
    144   INTEGER flag_aerosol
    145141  LOGICAL ok_cdnc
    146142  REAL bl95_b0, bl95_b1 ! Parameter in B&L 95-Formula
    … …  
    156152  REAL zrho(klon, klev) !--rho pour la couche
    157153  REAL dh(klon, klev) !--dz pour la couche
     154  REAL zfice(klon, klev)
    158155  REAL rad_chaud(klon, klev) !--rayon pour les nuages chauds
    159156  REAL rad_chaud_pi(klon, klev) !--rayon pour les nuages chauds pre-industriels
    … …  
    165162  REAL reliq_pi(klon, klev), reice_pi(klon, klev)
    166163
    167   REAL,SAVE :: cdnc_min=-1.
    168   REAL,SAVE :: cdnc_min_m3
    169   !$OMP THREADPRIVATE(cdnc_min,cdnc_min_m3)
    170   REAL,SAVE :: cdnc_max=-1.
    171   REAL,SAVE :: cdnc_max_m3
    172   !$OMP THREADPRIVATE(cdnc_max,cdnc_max_m3)
    173 
    174164  ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    175165  ! FH : 2011/05/24
    … …  
    183173  ! Pour retrouver les résultats numériques de la version d'origine,
    184174  ! on impose 0.71 quand on est proche de 0.71
    185 
    186   if (first) THEN
    187       call getin_p('cdnc_min',cdnc_min)
    188       cdnc_min_m3=cdnc_min*1.E6
    189       IF (cdnc_min_m3<0.) cdnc_min_m3=20.E6 ! astuce pour retrocompatibilite
    190       write(lunout,*)'cdnc_min=', cdnc_min_m3/1.E6
    191       call getin_p('cdnc_max',cdnc_max)
    192       cdnc_max_m3=cdnc_max*1.E6
    193       IF (cdnc_max_m3<0.) cdnc_max_m3=1000.E6 ! astuce pour retrocompatibilite
    194       write(lunout,*)'cdnc_max=', cdnc_max_m3/1.E6
    195   ENDIF
    196175
    197176  d_rei_dt = (rei_max-rei_min)/81.4
    … …  
    225204        xflwc(i, k) = (1.-zfice(i,k))*pqlwp(i, k)
    226205        xfiwc(i, k) = zfice(i, k)*pqlwp(i, k)
    227       ENDDO
    228     ENDDO
     206      END DO
     207    END DO
    229208  ELSE ! of IF (iflag_t_glace.EQ.0)
    230209    DO k = 1, klev
    … …  
    243222        xflwc(i, k) = (1.-zfice(i,k))*pqlwp(i, k)
    244223        xfiwc(i, k) = zfice(i, k)*pqlwp(i, k)
    245       ENDDO
    246     ENDDO
     224      END DO
     225    END DO
    247226  ENDIF
    248227
    … …  
    253232    DO k = 1, klev
    254233      DO i = 1, klon
     234
    255235        ! Formula "D" of Boucher and Lohmann, Tellus, 1995
    256236        ! Cloud droplet number concentration (CDNC) is restricted
    257237        ! to be within [20, 1000 cm^3]
    258238
     239        ! --present-day case
     240        cdnc(i, k) = 10.**(bl95_b0+bl95_b1*log(max(mass_solu_aero(i,k), &
     241          1.E-4))/log(10.))*1.E6 !-m-3
     242        cdnc(i, k) = min(1000.E6, max(20.E6,cdnc(i,k)))
     243
    259244        ! --pre-industrial case
    260245        cdnc_pi(i, k) = 10.**(bl95_b0+bl95_b1*log(max(mass_solu_aero_pi(i,k), &
    261246          1.E-4))/log(10.))*1.E6 !-m-3
    262         cdnc_pi(i, k) = min(cdnc_max_m3, max(cdnc_min_m3,cdnc_pi(i,k)))
    263 
    264       ENDDO
    265     ENDDO
    266 
    267     !--flag_aerosol=7 => MACv2SP climatology
    268     !--in this case there is an enhancement factor
    269     IF (flag_aerosol .EQ. 7) THEN
    270 
    271       !--present-day
    272       DO k = 1, klev
    273         DO i = 1, klon
    274           cdnc(i, k) = cdnc_pi(i,k)*dNovrN(i)
    275         ENDDO
    276       ENDDO
    277 
    278     !--standard case
    279     ELSE
    280 
    281       DO k = 1, klev
    282         DO i = 1, klon
    283 
    284           ! Formula "D" of Boucher and Lohmann, Tellus, 1995
    285           ! Cloud droplet number concentration (CDNC) is restricted
    286           ! to be within [20, 1000 cm^3]
    287 
    288           ! --present-day case
    289           cdnc(i, k) = 10.**(bl95_b0+bl95_b1*log(max(mass_solu_aero(i,k), &
    290             1.E-4))/log(10.))*1.E6 !-m-3
    291           cdnc(i, k) = min(cdnc_max_m3, max(cdnc_min_m3,cdnc(i,k)))
    292 
    293         ENDDO
    294       ENDDO
    295 
    296     ENDIF !--flag_aerosol
    297 
    298     !--computing cloud droplet size
    299     DO k = 1, klev
    300       DO i = 1, klon
     247        cdnc_pi(i, k) = min(1000.E6, max(20.E6,cdnc_pi(i,k)))
    301248
    302249        ! --present-day case
    … …  
    333280            zfiwp_var*(3.448E-03+2.431/rei)
    334281
    335         ENDIF
    336 
    337       ENDDO
    338     ENDDO
     282        END IF
     283
     284      END DO
     285    END DO
    339286
    340287  ELSE !--not ok_cdnc
    … …  
    346293        rad_chaud(i, k) = rad_chau2
    347294        rad_chaud_pi(i, k) = rad_chau2
    348       ENDDO
    349     ENDDO
     295      END DO
     296    END DO
    350297    DO k = min(3, klev) + 1, klev
    351298      DO i = 1, klon
    352299        rad_chaud(i, k) = rad_chau1
    353300        rad_chaud_pi(i, k) = rad_chau1
    354       ENDDO
    355     ENDDO
    356 
    357   ENDIF !--ok_cdnc
     301      END DO
     302    END DO
     303
     304  END IF !--ok_cdnc
    358305
    359306  ! --computation of cloud optical depth and emissivity
    … …  
    430377        pclemi(i, k) = 1.0 - exp(-coef_chau*zflwp_var-df*k_ice*zfiwp_var)
    431378
    432       ENDIF
     379      END IF
    433380
    434381      reice(i, k) = rei
    … …  
    437384      xfiwp(i) = xfiwp(i) + xfiwc(i, k)*rhodz(i, k)
    438385
    439     ENDDO
    440   ENDDO
     386    END DO
     387  END DO
    441388
    442389  ! --if cloud droplet radius is fixed, then pcldtaupi=pcltau
    … …  
    447394        pcldtaupi(i, k) = pcltau(i, k)
    448395        reice_pi(i, k) = reice(i, k)
    449       ENDDO
    450     ENDDO
    451   ENDIF
     396      END DO
     397    END DO
     398  END IF
    452399
    453400  DO k = 1, klev
    … …  
    456403      reliq_pi(i, k) = rad_chaud_pi(i, k)
    457404      reice_pi(i, k) = reice(i, k)
    458     ENDDO
    459   ENDDO
     405    END DO
     406  END DO
    460407
    461408  ! COMPUTE CLOUD LIQUID PATH AND TOTAL CLOUDINESS
    … …  
    473420    pcl(i) = 1.0
    474421    pctlwp(i) = 0.0
    475   ENDDO
     422  END DO
    476423
    477424  ! --calculation of liquid water path
    … …  
    480427    DO i = 1, klon
    481428      pctlwp(i) = pctlwp(i) + pqlwp(i, k)*rhodz(i, k)
    482     ENDDO
    483   ENDDO
     429    END DO
     430  END DO
    484431
    485432  ! --calculation of cloud properties with cloud overlap
    … …  
    503450            (i),kind=8),1.-zepsec))
    504451          zcloudl(i) = pclc(i, k)
    505         ENDIF
     452        END IF
    506453        zcloud(i) = pclc(i, k)
    507       ENDDO
    508     ENDDO
     454      END DO
     455    END DO
    509456  ELSE IF (novlp==2) THEN
    510457    DO k = klev, 1, -1
    … …  
    518465        ELSE IF (paprs(i,k)>=prlmc) THEN
    519466          pcl(i) = min(pclc(i,k), pcl(i))
    520         ENDIF
    521       ENDDO
    522     ENDDO
     467        END IF
     468      END DO
     469    END DO
    523470  ELSE IF (novlp==3) THEN
    524471    DO k = klev, 1, -1
    … …  
    532479        ELSE IF (paprs(i,k)>=prlmc) THEN
    533480          pcl(i) = pcl(i)*(1.0-pclc(i,k))
    534         ENDIF
    535       ENDDO
    536     ENDDO
    537   ENDIF
     481        END IF
     482      END DO
     483    END DO
     484  END IF
    538485
    539486  DO i = 1, klon
    … …  
    541488    pcm(i) = 1. - pcm(i)
    542489    pcl(i) = 1. - pcl(i)
    543   ENDDO
     490  END DO
    544491
    545492  ! ========================================================
    … …  
    562509        ELSE
    563510          lcc3d(i, k) = pclc(i, k)*phase3d(i, k)
    564         ENDIF
     511        END IF
    565512        scdnc(i, k) = lcc3d(i, k)*cdnc(i, k) ! m-3
    566       ENDDO
    567     ENDDO
     513      END DO
     514    END DO
    568515
    569516    DO i = 1, klon
    … …  
    573520      IF (novlp.EQ.3 .OR. novlp.EQ.1) tcc(i) = 1.
    574521      IF (novlp.EQ.2) tcc(i) = 0.
    575     ENDDO
     522    END DO
    576523
    577524    DO i = 1, klon
    … …  
    587534              WRITE (*, *) 'Hypothese de recouvrement: MAXIMUM'
    588535              first = .FALSE.
    589             ENDIF
     536            END IF
    590537            flag_max = -1.
    591538            ftmp(i) = max(tcc(i), pclc(i,k))
    592           ENDIF
     539          END IF
    593540
    594541          IF (novlp.EQ.3) THEN
    … …  
    596543              WRITE (*, *) 'Hypothese de recouvrement: RANDOM'
    597544              first = .FALSE.
    598             ENDIF
     545            END IF
    599546            flag_max = 1.
    600547            ftmp(i) = tcc(i)*(1-pclc(i,k))
    601           ENDIF
     548          END IF
    602549
    603550          IF (novlp.EQ.1) THEN
    … …  
    607554                &                                          RANDOM'
    608555              first = .FALSE.
    609             ENDIF
     556            END IF
    610557            flag_max = 1.
    611558            ftmp(i) = tcc(i)*(1.-max(pclc(i,k),pclc(i,k+1)))/(1.-min(pclc(i, &
    612559              k+1),1.-thres_neb))
    613           ENDIF
     560          END IF
    614561          ! Effective radius of cloud droplet at top of cloud (m)
    615562          reffclwtop(i) = reffclwtop(i) + rad_chaud(i, k)*1.0E-06*phase3d(i, &
    … …  
    623570          tcc(i) = ftmp(i)
    624571
    625         ENDIF ! is there a visible, not-too-small cloud?
    626       ENDDO ! loop over k
     572        END IF ! is there a visible, not-too-small cloud?
     573      END DO ! loop over k
    627574
    628575      IF (novlp.EQ.3 .OR. novlp.EQ.1) tcc(i) = 1. - tcc(i)
    629576
    630     ENDDO ! loop over i
     577    END DO ! loop over i
    631578
    632579    ! ! Convective and Stratiform Cloud Droplet Effective Radius (REFFCLWC
    … …  
    639586        lcc3dstra(i, k) = lcc3dstra(i, k) - lcc3dcon(i, k) ! eau liquide stratiforme
    640587        lcc3dstra(i, k) = max(lcc3dstra(i,k), 0.0)
    641         !FC pour la glace (CAUSES)
    642         icc3dcon(i, k) = rnebcon(i, k)*(1-phase3d(i, k))*clwcon(i, k) !  glace convective
    643         icc3dstra(i, k)= pclc(i, k)*pqlwp(i, k)*(1-phase3d(i, k))
    644         icc3dstra(i, k) = icc3dstra(i, k) - icc3dcon(i, k) ! glace stratiforme
    645         icc3dstra(i, k) = max( icc3dstra(i, k), 0.0)
    646         !FC (CAUSES)
    647 
    648588        ! Compute cloud droplet radius as above in meter
    649589        radius = 1.1*((pqlwp(i,k)*pplay(i,k)/(rd*t(i,k)))/(4./3*rpi*1000.* &
    … …  
    656596        reffclws(i, k) = radius
    657597        reffclws(i, k) = reffclws(i, k)*lcc3dstra(i, k)
    658       ENDDO !klev
    659     ENDDO !klon
     598      END DO !klev
     599    END DO !klon
    660600
    661601    ! Column Integrated Cloud Droplet Number (CLDNVI) : variable 2D
    … …  
    669609        lcc_integrat(i) = lcc_integrat(i) + lcc3d(i, k)*dh(i, k)
    670610        height(i) = height(i) + dh(i, k)
    671       ENDDO ! klev
     611      END DO ! klev
    672612      lcc_integrat(i) = lcc_integrat(i)/height(i)
    673613      IF (lcc_integrat(i)<=1.0E-03) THEN
    … …  
    675615      ELSE
    676616        cldnvi(i) = cldnvi(i)*lcc(i)/lcc_integrat(i)
    677       ENDIF
    678     ENDDO ! klon
     617      END IF
     618    END DO ! klon
    679619
    680620    DO i = 1, klon
    … …  
    686626        IF (lcc3dcon(i,k)<=0.0) lcc3dcon(i, k) = 0.0
    687627        IF (lcc3dstra(i,k)<=0.0) lcc3dstra(i, k) = 0.0
    688 !FC (CAUSES)
    689         IF (icc3dcon(i,k)<=0.0) icc3dcon(i, k) = 0.0
    690         IF (icc3dstra(i,k)<=0.0) icc3dstra(i, k) = 0.0
    691 !FC (CAUSES)
    692       ENDDO
     628      END DO
    693629      IF (reffclwtop(i)<=0.0) reffclwtop(i) = 0.0
    694630      IF (cldncl(i)<=0.0) cldncl(i) = 0.0
    695631      IF (cldnvi(i)<=0.0) cldnvi(i) = 0.0
    696632      IF (lcc(i)<=0.0) lcc(i) = 0.0
    697     ENDDO
    698 
    699   ENDIF !ok_cdnc
    700 
    701   first=.false. !to be sure
     633    END DO
     634
     635  END IF !ok_cdnc
    702636
    703637  RETURN
Note: See TracChangeset for help on using the changeset viewer.