Changeset 1174 for trunk/LMDZ.GENERIC/libf

Timestamp:

Feb 3, 2014, 9:39:45 AM (11 years ago)

Author:

sglmd

Message:

Calculation of the insolation for a flattened planet. New keyword flatten =(a-b)/a (default value =0.).

Location:

trunk/LMDZ.GENERIC/libf/phystd

Files:

• callkeys.h (modified) (5 diffs)
• inifis.F (modified) (3 diffs)
• mucorr.F (modified) (7 diffs)
• physiq.F90 (modified) (4 diffs)
• stelang.F (modified) (4 diffs)

trunk/LMDZ.GENERIC/libf/phystd/callkeys.h

@@ -12 +12 @@
      &   , meanOLR, specOLR                                             &
      &   , kastprof, Tstrat                                             &
-     &   , nosurf, intheat                                              &     
+     &   , nosurf, intheat, flatten                                     &     
      &   , newtonian, tau_relax, testradtimes                           &
      &   , check_cpp_match, force_cpp                                   &
@@ -30 +30 @@
      &   , tracer, mass_redistrib, varactive, varfixed, satval          &
      &   , sedimentation,water,watercond,waterrain                      &
-     &   , aeroco2,aeroh2o,aeroh2so4,aeroback2lay                         &
+     &   , aeroco2,aeroh2o,aeroh2so4,aeroback2lay, aeronh3              &
      &   , aerofixco2,aerofixh2o                                        &
      &   , hydrology, sourceevol, icetstep, albedosnow                  &
@@ -43 +43 @@
       logical callrad,corrk,calldifv,UseTurbDiff                        &
      &   , calladj,co2cond,callsoil                                     &
-     &   , season,diurnal,tlocked,rings_shadow,lwrite                                &
+     &   , season,diurnal,tlocked,rings_shadow,lwrite                   &
      &   , callstats,calleofdump                                        &
      &   , callgasvis,continuum,H2Ocont_simple,graybody                 &
@@ -69 +69 @@
       logical water,watercond,waterrain
       logical aeroco2,aeroh2o,aeroh2so4,aeroback2lay
-      logical aerofixco2,aerofixh2o
+      logical aerofixco2,aerofixh2o, aeronh3
       logical hydrology
       logical sourceevol
@@ -107 +107 @@
       real icetstep
       real intheat
+      real flatten

trunk/LMDZ.GENERIC/libf/phystd/inifis.F

@@ -158 +158 @@
          write(*,*) "rings_shadow = ", rings_shadow
          
+         write(*,*) "Flattening of the planet (a-b)/a ?"
+         flatten = 0.0
+         call getin("flatten", flatten)
+         write(*,*) "flatten = ", flatten
+         
 ! Test of incompatibility:
 ! if tlocked, then diurnal should be false
@@ -448 +453 @@
          call getin("aeroback2lay",aeroback2lay)
          write(*,*)" aeroback2lay = ",aeroback2lay
+
+         write(*,*)"Radiatively active ammonia cloud?"
+         aeronh3=.false.     ! default value
+         call getin("aeronh3",aeronh3)
+         write(*,*)" aeronh3 = ",aeronh3
 
          write(*,*)"TWOLAY AEROSOL: total optical depth ",
@@ -665 +675 @@
          coslon(ig)=cos(plon(ig))
       ENDDO
-
+         
       pi=2.*asin(1.) ! NB: pi is a common in comcstfi.h
 

trunk/LMDZ.GENERIC/libf/phystd/mucorr.F

@@ -1 @@
-      SUBROUTINE mucorr(npts,pdeclin, plat, pmu, pfract,phaut,prad)
+      SUBROUTINE mucorr(npts,pdeclin, plat, pmu,pfract,phaut,prad,pflat)
       IMPLICIT NONE
 
@@ -34 +34 @@
       INTEGER npts
       REAL plat(npts),pmu(npts), pfract(npts)
-      REAL phaut,prad,pdeclin
+      REAL phaut,prad,pdeclin, pflat
 c
 c     Local variables :
@@ -41 +41 @@
       REAL pi
       REAL z,cz,sz,tz,phi,cphi,sphi,tphi
-      REAL ap,a,t,b, tp
+      REAL ap,a,t,b, tp, rap
       REAL alph
 
 c-----------------------------------------------------------------------
+
+c----- SG: geometry adapted to a flattened planet (Feb2014)
 
       pi = 4. * atan(1.0)
@@ -50 +52 @@
       cz = cos (z)
       sz = sin (z)
+      rap = 1./((1.-pflat)**2)
 
       DO 20 j = 1, npts
@@ -59 +62 @@
          tphi = sphi / cphi
          b = cphi * cz
-         t = -tphi * sz / cz
+         t = -rap*tphi * sz / cz
          a = 1.0 - t*t
          ap = a
@@ -76 +79 @@
          t = tp
    
-         pmu(j) = (sphi*sz*t) / pi + b*sin(t)/pi
+         pmu(j) = (sphi*sz*t*rap) / pi + b*sin(t)/pi
          pfract(j) = t / pi
          IF (ap .lt.0.) then
-            pmu(j) = sphi * sz
+            pmu(j) = sphi * sz*rap
             pfract(j) = 1.0
          ENDIF
@@ -85 +88 @@
          pmu(j) = pmu(j) / pfract(j)
          IF (pmu(j).eq.0.) pfract(j) = 0.
+
+         pmu(j)=pmu(j)/SQRT(cphi**2 + (rap**2) * (sphi**2))
 
    20 CONTINUE

trunk/LMDZ.GENERIC/libf/phystd/physiq.F90

@@ -697 +697 @@
 
               call stelang(ngrid,sinlon,coslon,sinlat,coslat,    &
-               ztim1,ztim2,ztim3,mu0,fract)
+               ztim1,ztim2,ztim3,mu0,fract, flatten)
 
            elseif (diurnal) then
@@ -705 +705 @@
 
                call stelang(ngrid,sinlon,coslon,sinlat,coslat,    &
-               ztim1,ztim2,ztim3,mu0,fract)
+               ztim1,ztim2,ztim3,mu0,fract, flatten)
            else if(diurnal .eq. .false.) then
 
-               call mucorr(ngrid,declin,lati,mu0,fract,10000.,rad)
+               call mucorr(ngrid,declin,lati,mu0,fract,10000.,rad,flatten)
                ! WARNING: this function appears not to work in 1D
 
@@ -736 +736 @@
                   
                         call stelang(ngrid,sinlon,coslon,sinlat,coslat,    &
-                                 ztim1,ztim2,ztim3,tmp_mu0,tmp_fract)
+                                 ztim1,ztim2,ztim3,tmp_mu0,tmp_fract, flatten)
                   
-                        call rings(ngrid, declin, ptime_day, rad, 0., eclipse)
+                        call rings(ngrid, declin, ptime_day, rad, flatten, eclipse)
                   
                         fract(:) = fract(:) + (1.-eclipse(:))*tmp_fract(:) !! fract prend en compte l'ombre des anneaux et l'alternance jour/nuit
@@ -1767 +1767 @@
            call writediagfi(ngrid,"GND","heat flux from ground","W m-2",2,fluxgrd)
            call writediagfi(ngrid,"DYN","dynamical heat input","W m-2",2,fluxdyn)
-        endif
+         endif
         
         if(enertest) then

trunk/LMDZ.GENERIC/libf/phystd/stelang.F

@@ -1 +1 @@
       subroutine stelang(kgrid,psilon,pcolon,psilat,pcolat,
-     &                    ptim1,ptim2,ptim3,pmu0,pfract )
+     &                ptim1,ptim2,ptim3,pmu0,pfract, pflat)
       IMPLICIT NONE
 
@@ -66 +66 @@
 C
       INTEGER kgrid
-      REAL ptim1,ptim2,ptim3
+      REAL ptim1,ptim2,ptim3, pflat
       REAL psilon(kgrid),pcolon(kgrid),pmu0(kgrid),pfract(kgrid)
       REAL psilat(kgrid), pcolat(kgrid)
 C
       INTEGER jl
-      REAL ztim1,ztim2,ztim3
+      REAL ztim1,ztim2,ztim3, rap
 C------------------------------------------------------------------------
 C------------------------------------------------------------------------
@@ -81 +81 @@
 C             --------------
 C
+c----- SG: geometry adapted to a flattened planet (Feb2014)
+
+      rap = 1./((1.-pflat)**2)
+
  100  CONTINUE
 C
@@ -92 +96 @@
 C
       DO jl=1,kgrid
-        ztim1=psilat(jl)*ptim1
+        ztim1=psilat(jl)*ptim1*rap
         ztim2=pcolat(jl)*ptim2
         ztim3=pcolat(jl)*ptim3
         pmu0(jl)=ztim1+ztim2*pcolon(jl)+ztim3*psilon(jl)
+        pmu0(jl)=pmu0(jl)/SQRT(pcolat(jl)**2 + (rap**2) * (psilat(jl)**2))
+
       ENDDO
 C