Changeset 420 for trunk/LMDZ.MARS/libf

Timestamp:

Nov 24, 2011, 9:54:55 AM (14 years ago)

Author:

tnavarro

Message:

24/11/11 == TN

corrected minor bug in updatereffrad.F : reffdust was not saved

ccn_factor as not correctly used in sedimentation.

It is now initialized in inifis.F, declared in tracer.h and
used in both simpleclouds.F & callsedim.F to update ice radius.

Commented diagfi outputs in aeropacity.F & improvedclouds.F for non scavenging users.

Location:

trunk/LMDZ.MARS/libf/phymars

Files:

• aeropacity.F (modified) (2 diffs)
• callsedim.F (modified) (3 diffs)
• improvedclouds.F (modified) (6 diffs)
• inifis.F (modified) (2 diffs)
• physiq.F (modified) (2 diffs)
• simpleclouds.F (modified) (1 diff)
• tracer.h (modified) (2 diffs)
• updatereffrad.F (modified) (1 diff)

trunk/LMDZ.MARS/libf/phymars/aeropacity.F

@@ -442 +442 @@
       
 c output for debug
-        IF (ngrid.NE.1) THEN
-             CALL WRITEDIAGFI(ngridmx,'taudusttmp','virtual tau dust',
-     &      '#',2,taudusttmp)
-             CALL WRITEDIAGFI(ngridmx,'tausca','tauscaling',
-     &      '#',2,tauscaling)
-        ELSE
-             CALL WRITEDIAGFI(ngridmx,'taudusttmp','virtual tau dust',
-     &      '#',0,taudusttmp)
-             CALL WRITEDIAGFI(ngridmx,'tausca','tauscaling',
-     &      '#',0,tauscaling)
-        ENDIF
+c        IF (ngrid.NE.1) THEN
+c             CALL WRITEDIAGFI(ngridmx,'taudusttmp','virtual tau dust',
+c     &      '#',2,taudusttmp)
+c             CALL WRITEDIAGFI(ngridmx,'tausca','tauscaling',
+c     &      '#',2,tauscaling)
+c        ELSE
+c             CALL WRITEDIAGFI(ngridmx,'taudusttmp','virtual tau dust',
+c     &      '#',0,taudusttmp)
+c             CALL WRITEDIAGFI(ngridmx,'tausca','tauscaling',
+c     &      '#',0,tauscaling)
+c        ENDIF
 c -----------------------------------------------------------------
 c Column integrated visible optical depth in each point
@@ -466 +466 @@
 c Density scaled opacity and column opacity output
 c -----------------------------------------------------------------
-      dsodust(1:ngrid,1:nlayer) = 0.
-      DO iaer=1,naerdust
-        DO l=1,nlayermx
-          DO ig=1,ngrid
-            dsodust(ig,l) = dsodust(ig,l) +
-     &                      aerosol(ig,l,iaerdust(iaer)) * g /
-     &                      (pplev(ig,l) - pplev(ig,l+1))
-          ENDDO
-        ENDDO
-        IF (ngrid.NE.1) THEN
-          write(txt2,'(i1.1)') iaer
-          call WRITEDIAGFI(ngridmx,'taudust'//txt2,
-     &                    'Dust col opacity',
-     &                    ' ',2,tau(1,iaerdust(iaer)))
-          IF (callstats) THEN
-            CALL wstats(ngridmx,'taudust'//txt2,
-     &                 'Dust col opacity',
-     &                 ' ',2,tau(1,iaerdust(iaer)))
-          ENDIF
-        ENDIF
-      ENDDO
-
-      IF (ngrid.NE.1) THEN
+c      dsodust(1:ngrid,1:nlayer) = 0.
+c      DO iaer=1,naerdust
+c        DO l=1,nlayermx
+c          DO ig=1,ngrid
+c            dsodust(ig,l) = dsodust(ig,l) +
+c     &                      aerosol(ig,l,iaerdust(iaer)) * g /
+c     &                      (pplev(ig,l) - pplev(ig,l+1))
+c          ENDDO
+c        ENDDO
+c        IF (ngrid.NE.1) THEN
+c          write(txt2,'(i1.1)') iaer
+c          call WRITEDIAGFI(ngridmx,'taudust'//txt2,
+c     &                    'Dust col opacity',
+c     &                    ' ',2,tau(1,iaerdust(iaer)))
+c          IF (callstats) THEN
+c            CALL wstats(ngridmx,'taudust'//txt2,
+c     &                 'Dust col opacity',
+c     &                 ' ',2,tau(1,iaerdust(iaer)))
+c          ENDIF
+c        ENDIF
+c      ENDDO
+
+c      IF (ngrid.NE.1) THEN
 c       CALL WRITEDIAGFI(ngridmx,'dsodust','tau*g/dp',
 c    &                    'm2.kg-1',3,dsodust)
-        IF (callstats) THEN
-          CALL wstats(ngridmx,'dsodust',
-     &               'tau*g/dp',
-     &               'm2.kg-1',3,dsodust)
-        ENDIF
-      ELSE
-        CALL WRITEDIAGFI(ngrid,"dsodust","dsodust","m2.kg-1",1,
-     &                   dsodust)
-      ENDIF ! of IF (ngrid.NE.1)
+c        IF (callstats) THEN
+c          CALL wstats(ngridmx,'dsodust',
+c     &               'tau*g/dp',
+c     &               'm2.kg-1',3,dsodust)
+c        ENDIF
+c      ELSE
+c        CALL WRITEDIAGFI(ngrid,"dsodust","dsodust","m2.kg-1",1,
+c     &                   dsodust)
+c      ENDIF ! of IF (ngrid.NE.1)
 c -----------------------------------------------------------------
       return

trunk/LMDZ.MARS/libf/phymars/callsedim.F

@@ -73 +73 @@
       
 c     for ice radius computation
-      REAL ccn_factor
       REAL Mo,No
       REAL tau(ngrid,nlay), tauscaling(ngrid)
@@ -200 +199 @@
             stop
           endif
-        ELSE
-          write(*,*) "water_param CCN reduc. fac. ", ccn_factor
-          write(*,*) "Careful: only used when microphys=F, otherwise"
-          write(*,*) "  the contact parameter is used instead;"
         ENDIF !of if (scavenging)
 
@@ -461 +456 @@
             rice(ig,l)=max( CBRT ( (zqi(ig,l,igcm_h2o_ice)/rho_ice
      &      +ccntyp*(4./3.)*pi*rdust(ig,l)**3.)
-     &      /(ccntyp*4./3.*pi) ), rdust(ig,l))      
+     &      /(ccntyp*4./3.*pi) ), rdust(ig,l))
           ENDDO
         ENDDO

trunk/LMDZ.MARS/libf/phymars/improvedclouds.F

@@ -111 +111 @@
       REAL sigma_ice ! Variance of the ice and CCN distributions
       SAVE sigma_ice
-      
-c some outputs for 1D      
+
+c----------------------------------      
+c some outputs for 1D -- TEMPORARY
       REAL satu_out(ngridmx,nlayermx) ! satu ratio for output
       REAL dN_out(ngridmx,nlayermx)  ! mass variation for output
@@ -125 +126 @@
       REAL Mccn_col(ngridmx)         ! total column ccn mass
       REAL Nccn_col(ngridmx)         ! total column ccn mass
-      REAL count
-
+      INTEGER count
+      
+      LOGICAL output_sca     ! scavenging outputs flag for tests
+      output_sca = .false.
+c----------------------------------      
+c----------------------------------      
 
 c------------------------------------------------------------------
@@ -428 +433 @@
           satu_out(ig,l) = satu
           Mcon_out(ig,l) = 0
-          newvap_out(ig,l) = zq(ig,l,igcm_h2o_ice)
-          gr_out(ig,l) = gr
-          dN_out(ig,l) = dN
-          dM_out(ig,l) = dM
+          newvap_out(ig,l) = zq(ig,l,igcm_h2o_vap)
+          gr_out(ig,l) = 0
+          dN_out(ig,l) = 0
+          dM_out(ig,l) = 0
          
         ENDIF ! end if (saturation ratio > 1) or (there is h2o_ice)
@@ -473 +478 @@
 c------------------------------------------------------------------
 c     TESTS
+
+      IF (output_sca) then
  
       print*, 'count is ',count, ' i.e. ',
      &     count*100/(nlay*ngrid), '% for microphys computation'      
 
-c      dM_col(:)    = 0
-c      dN_col(:)    = 0
-c      Mdust_col(:) = 0
-c      Ndust_col(:) = 0
-c      Mccn_col(:)  = 0
-c      Nccn_col(:)  = 0
-c      do l=1, nlay
-c        do ig=1,ngrid
-c          dM_col(ig) = dM_col(ig) + 
-c     &       dM_out(ig,l)*(pplev(ig,l) - pplev(ig,l+1)) / g
-c          dN_col(ig) = dN_col(ig) + 
-c     &       dN_out(ig,l)*(pplev(ig,l) - pplev(ig,l+1)) / g
-c          Mdust_col(ig) = Mdust_col(ig) + 
-c     &       zq(ig,l,igcm_dust_mass)*tauscaling(ig)
-c     &       *(pplev(ig,l) - pplev(ig,l+1)) / g
-c          Ndust_col(ig) = Ndust_col(ig) + 
-c     &       zq(ig,l,igcm_dust_number)*tauscaling(ig)
-c     &       *(pplev(ig,l) - pplev(ig,l+1)) / g
-c          Mccn_col(ig) = Mccn_col(ig) + 
-c     &       zq(ig,l,igcm_ccn_mass)*tauscaling(ig)
-c     &       *(pplev(ig,l) - pplev(ig,l+1)) / g
-c          Nccn_col(ig) = Nccn_col(ig) + 
-c     &       zq(ig,l,igcm_ccn_number)*tauscaling(ig)
-c     &       *(pplev(ig,l) - pplev(ig,l+1)) / g
-c        enddo ! of do ig=1,ngrid
-c      enddo ! of do l=1,nlay
-
-
-      IF (ngrid.eq.0) THEN ! 3D
+      dM_col(:)    = 0
+      dN_col(:)    = 0
+      Mdust_col(:) = 0
+      Ndust_col(:) = 0
+      Mccn_col(:)  = 0
+      Nccn_col(:)  = 0
+      do l=1, nlay
+        do ig=1,ngrid
+          dM_col(ig) = dM_col(ig) + 
+     &       dM_out(ig,l)*(pplev(ig,l) - pplev(ig,l+1)) / g
+          dN_col(ig) = dN_col(ig) + 
+     &       dN_out(ig,l)*(pplev(ig,l) - pplev(ig,l+1)) / g
+          Mdust_col(ig) = Mdust_col(ig) + 
+     &       zq(ig,l,igcm_dust_mass)*tauscaling(ig)
+     &       *(pplev(ig,l) - pplev(ig,l+1)) / g
+          Ndust_col(ig) = Ndust_col(ig) + 
+     &       zq(ig,l,igcm_dust_number)*tauscaling(ig)
+     &       *(pplev(ig,l) - pplev(ig,l+1)) / g
+          Mccn_col(ig) = Mccn_col(ig) + 
+     &       zq(ig,l,igcm_ccn_mass)*tauscaling(ig)
+     &       *(pplev(ig,l) - pplev(ig,l+1)) / g
+          Nccn_col(ig) = Nccn_col(ig) + 
+     &       zq(ig,l,igcm_ccn_number)*tauscaling(ig)
+     &       *(pplev(ig,l) - pplev(ig,l+1)) / g
+        enddo ! of do ig=1,ngrid
+      enddo ! of do l=1,nlay
+
+
+      IF (ngrid.ne.1) THEN ! 3D
          call WRITEDIAGFI(ngrid,"satu","ratio saturation","",3,
      &                    satu_out)
@@ -544 +551 @@
          call WRITEDIAGFI(ngrid,"rice_sca","ice radius","m",1,
      &                    rice)
-         call WRITEDIAGFI(ngrid,"rdust","rdust","m",1,
+         call WRITEDIAGFI(ngrid,"rdust_sca","rdust","m",1,
      &                    rdust)
          call WRITEDIAGFI(ngrid,"rsedcloud","rsedcloud","m",1,
@@ -563 +570 @@
      &                    Mccn_col)
       ENDIF
+      ENDIF ! endif output_sca
 c------------------------------------------------------------------
       return

trunk/LMDZ.MARS/libf/phymars/inifis.F

@@ -62 +62 @@
 #include "slope.h"
 #include "microphys.h"
+#include "tracer.h"
 #ifdef MESOSCALE
 #include "comsoil.h"     !!MESOSCALE -- needed to fill volcapa
@@ -417 +418 @@
            stop
          endif
+         
+! ccn factor if no scavenging         
+        write(*,*) "water param CCN reduc. factor ?", ccn_factor
+        ccn_factor = 4.5
+        call getin("ccn_factor",ccn_factor)
+        write(*,*)" ccn_factor = ",ccn_factor
+        write(*,*)"Careful: only used when microphys=F, otherwise"
+        write(*,*)"the contact parameter is used instead;"
+
 ! microphys
          write(*,*)"Microphysical scheme for water-ice clouds?"

trunk/LMDZ.MARS/libf/phymars/physiq.F

@@ -318 +318 @@
 c Test 1d/3d scavenging
       real h2o_tot
-      real ccndust_mass(nlayermx)
-      real ccndust_number(nlayermx)
-      real rescale                ! to rescale GCM dust quantities
 
       REAL time_phys
@@ -1994 +1991 @@
            do l=1,nlayer
              h2o_tot = h2o_tot + 
-     &           (zq(ig,l,igcm_h2o_vap) + zq(ig,l,igcm_h2o_ice))
-     &                     * (pplev(ig,l) - pplev(ig,l+1)) / g
-             ccndust_mass(l) = 
-     &       pq(1,l,igcm_dust_mass)+pq(1,l,igcm_ccn_mass)
-             ccndust_number(l) = 
-     &       pq(1,l,igcm_dust_number)+pq(1,l,igcm_ccn_number)
-     
+     &           (zq(1,l,igcm_h2o_vap) + zq(1,l,igcm_h2o_ice))
+     &                     * (pplev(1,l) - pplev(1,l+1)) / g
            end do
  

trunk/LMDZ.MARS/libf/phymars/simpleclouds.F

@@ -89 +89 @@
                                       ! Typical dust number density (#/kg)
 c     CCN reduction factor
-      REAL, PARAMETER :: ccn_factor = 4.5  !! comme TESTS_JB // 1. avant
+c      REAL, PARAMETER :: ccn_factor = 4.5  !! comme TESTS_JB // 1. avant
       
       REAL Mcon_out(ngridmx,nlayermx) ! mass to be condensed (not dMice !!)
-
-
-c------------------------------------------------------------------
-
-c     Write ccn_factor;
-      IF (firstcall) THEN
-        write(*,*) "water_param CCN reduc. fac. ", ccn_factor
-        write(*,*) "Careful: only used when microphys=F, otherwise"
-        write(*,*) "  the contact parameter is used instead;"
-        firstcall=.false.
-      END IF
 
 c-----------------------------------------------------------------------

trunk/LMDZ.MARS/libf/phymars/tracer.h

@@ -16 +16 @@
       real nuice_sed   ! Sedimentation effective variance of the water ice dist.
       real ref_r0        ! for computing reff=ref_r0*r0 (in log.n. distribution)
+      
+      real ccn_factor  ! ratio of nuclei for water ice particles
 
       real dryness(ngridmx)!"Dryness coefficient" for grnd water ice sublimation
@@ -73 +75 @@
       COMMON/tracer/radius,rho_q,alpha_lift,alpha_devil,mmol,           &
      & varian,r3n_q,rho_dust,rho_ice,nuice_ref,nuice_sed,               &
-     & ref_r0,dryness
+     & ref_r0,ccn_factor,dryness
       COMMON/tracer2/                                                   &
      & igcm_dustbin,igcm_dust_mass,igcm_dust_number,                    &

trunk/LMDZ.MARS/libf/phymars/updatereffrad.F

@@ -76 +76 @@
       EXTERNAL CBRT
 
-      real nueffdust(ngridmx,nlayermx) ! Dust effective variance
+      REAL,SAVE :: nueffdust(ngridmx,nlayermx) ! Dust effective variance
 
 c     Local saved variables: