Only in oldmeso: .svn
diff --ignore-blank-lines --context=3 -r oldgcm/aeropacity.F oldmeso/aeropacity.F
*** oldgcm/aeropacity.F	Thu Sep 30 19:55:34 2010
--- oldmeso/aeropacity.F	Tue Jan 25 16:49:09 2011
***************
*** 115,120 ****
--- 115,132 ----
        INTEGER,SAVE :: i_ice=0  ! water ice
        CHARACTER(LEN=20) :: tracername ! to temporarly store text
  
+ c **********************************************************
+ c    Declaration special local dust storm TASI   
+          logical localstorm
+          real taulocref,ztoploc,radloc,lonloc,latloc
+          integer ltoploc
+          real tauloc ! diagnostic only
+ c **********************************************************
+ 
+ 
+ 
+ 
+ 
        call zerophys(ngrid*naerkind,tau)
  
  ! identify tracers
***************
*** 297,302 ****
--- 309,362 ----
              ENDDO
            ENDDO
  
+ c ***************************************************************
+ c    SPECIAL LOCAL DUST STORM TASI
+ c    We modify only aerosol calculated above where the local dust storm is 
+ 
+       localstorm =  .true.
+       if (localstorm) then
+          taulocref = 2 !10  ! ref optical depth of the local dust storm
+          ztoploc = 11    ! target pseudo-altitude of local storm (km)
+          radloc = 4.     ! radius of dust storm (degree)
+          lonloc=-3       ! center longitude of storm (deg)
+          latloc=-2.      ! center latitude of storm (deg)
+ 
+          DO ig=1,ngrid
+ c          Where is the dust storm:
+            if (((lati(ig)*180./pi-latloc)**2 
+      &       + (long(ig)*180./pi -lonloc)**2).le.(radloc**2))then
+ c             Computing where is the top level of the localstorm
+               DO l=nlayer,1,-1
+                 ltoploc=l+1
+                 if(-10*log(pplev(ig,l)/pplev(ig,1)).lt.ztoploc)goto 88
+               END DO
+  88           continue
+               DO l=1,ltoploc-1
+                  aerosol(ig,l,1)=max(aerosol(ig,l,1),
+      &                  taulocref* (pplev(ig,l)-pplev(ig,l+1))
+      &                 /(pplev(ig,1)-pplev(ig,ltoploc)))
+               END DO
+ 
+ c             diagnostic
+               write(*,*)
+               write(*,*) 'lat,lon',lati(ig)*180./pi,long(ig)*180./pi 
+               write(*,*) 'true dustorm top pseudo-height (km) = ',
+      &          -10*log(pplev(ig,ltoploc)/pplev(ig,1))
+ c             tauloc=0.
+ c             DO l=1,nlayer
+ c              tauloc = tauloc + aerosol(ig,l,1)
+ c              write(*,*) 'below ',
+ c    &          -10*log(pplev(ig,l+1)/pplev(ig,1)),
+ c    &         'km, tau=', tauloc 
+ c             ENDDO
+ 
+            endif
+          END DO
+       endif
+ c ***************************************************************
+ 
+ 
+ 
            CALL zerophys(ngrid,taudustvis)
            CALL zerophys(ngrid,taudusttes)
            DO l=1,nlayer
***************
*** 431,440 ****
          ENDDO
  c       3. Outputs
          IF (ngrid.NE.1) THEN
!           CALL WRITEDIAGFI(ngridmx,'tauTES','tauabs IR refwvl',
!      &      ' ',2,taucloudtes)
!           CALL wstats(ngridmx,'tauTES','tauabs IR refwvl',
!      &      ' ',2,taucloudtes)
          ELSE
            CALL writeg1d(ngrid,1,taucloudtes,'tautes','NU')
          ENDIF
--- 491,500 ----
          ENDDO
  c       3. Outputs
          IF (ngrid.NE.1) THEN
! !          CALL WRITEDIAGFI(ngridmx,'tauTES','tauabs IR refwvl',
! !     &      ' ',2,taucloudtes)
! !          CALL wstats(ngridmx,'tauTES','tauabs IR refwvl',
! !     &      ' ',2,taucloudtes)
          ELSE
            CALL writeg1d(ngrid,1,taucloudtes,'tautes','NU')
          ENDIF
Only in oldgcm: aeropacity.F.old
diff --ignore-blank-lines --context=3 -r oldgcm/aeropacity.F~ oldmeso/aeropacity.F~
*** oldgcm/aeropacity.F~	Tue Feb  2 15:41:20 2010
--- oldmeso/aeropacity.F~	Tue Jan 25 16:49:10 2011
***************
*** 2,7 ****
--- 2,9 ----
       &    tauref,tau,aerosol,reffrad,
       &    QREFvis3d,QREFir3d,omegaREFvis3d,omegaREFir3d)
                                                     
+ ! to use  'getin'
+       USE ioipsl_getincom 
         IMPLICIT NONE
  c=======================================================================
  c   subject:
***************
*** 160,165 ****
--- 162,171 ----
            WRITE(*,*) "Qext/Qabs(IR): ",mqextsqabs(:,iaer)
          ENDDO
  
+ !       load value of tauvis from callphys.def (if given there,
+ !       otherwise default value read from starfi.nc file will be used)
+         call getin("tauvis",tauvis)
+ 
          firstcall=.false.
  
        END IF
***************
*** 178,186 ****
  
  c       Vertical column optical depth at 700.Pa 
  c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!         IF(iaervar.eq.1) THEN
             do ig=1, ngridmx
!             tauref(ig)=max(tauvis,1.e-9) ! tauvis=cste as read in starfi
            end do
          ELSE IF (iaervar.eq.2) THEN   ! << "Viking" Scenario>>
  
--- 184,193 ----
  
  c       Vertical column optical depth at 700.Pa 
  c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!         IF(iaervar.eq.1) THEN 
             do ig=1, ngridmx
!             tauref(ig)=max(tauvis,1.e-9) ! tauvis=cste (set in callphys.def
!                                          ! or read in starfi
            end do
          ELSE IF (iaervar.eq.2) THEN   ! << "Viking" Scenario>>
  
***************
*** 301,310 ****
            IF (ngrid.NE.1) THEN
  !            CALL WRITEDIAGFI(ngridmx,'taudustTES','dust abs IR',
  !     &        ' ',2,taudusttes)
!             IF (callstats) THEN
!               CALL wstats(ngridmx,'taudustTES','dust abs IR',
!      &          ' ',2,taudusttes)
!             ENDIF
            ELSE
              CALL writeg1d(ngrid,1,taudusttes,'taudusttes','NU')
            ENDIF
--- 309,316 ----
            IF (ngrid.NE.1) THEN
  !            CALL WRITEDIAGFI(ngridmx,'taudustTES','dust abs IR',
  !     &        ' ',2,taudusttes)
! !            CALL wstats(ngridmx,'taudustTES','dust abs IR',
! !     &        ' ',2,taudusttes)
            ELSE
              CALL writeg1d(ngrid,1,taudusttes,'taudusttes','NU')
            ENDIF
***************
*** 420,431 ****
          ENDDO
  c       3. Outputs
          IF (ngrid.NE.1) THEN
!           CALL WRITEDIAGFI(ngridmx,'tauTES','tauabs IR refwvl',
!      &      ' ',2,taucloudtes)
!           IF (callstats) THEN
!             CALL wstats(ngridmx,'tauTES','tauabs IR refwvl',
!      &        ' ',2,taucloudtes)
!           ENDIF
          ELSE
            CALL writeg1d(ngrid,1,taucloudtes,'tautes','NU')
          ENDIF
--- 426,435 ----
          ENDDO
  c       3. Outputs
          IF (ngrid.NE.1) THEN
! !          CALL WRITEDIAGFI(ngridmx,'tauTES','tauabs IR refwvl',
! !     &      ' ',2,taucloudtes)
! !          CALL wstats(ngridmx,'tauTES','tauabs IR refwvl',
! !     &      ' ',2,taucloudtes)
          ELSE
            CALL writeg1d(ngrid,1,taucloudtes,'tautes','NU')
          ENDIF
Only in oldgcm: aeroptproperties.F.old
Only in oldmeso: assim_aeropacity.F
Only in oldmeso: assim_readtesassim.F90
Only in oldgcm: calldrag_noro.F
diff --ignore-blank-lines --context=3 -r oldgcm/callkeys.h oldmeso/callkeys.h
*** oldgcm/callkeys.h	Tue Feb  2 15:41:20 2010
--- oldmeso/callkeys.h	Tue Jan 25 15:17:44 2011
***************
*** 39,44 ****
--- 39,45 ----
        real alphan
        real solarcondate
  
+       integer ecri_phys 
        integer iddist
        integer iaervar
        integer iradia
***************
*** 52,57 ****
--- 53,59 ----
        integer dustbin
        logical active,doubleq,lifting,callddevil,scavenging
        logical sedimentation,activice,water,caps
+       !!! plus besoin de iceparty ??
        logical photochem
        integer nqchem_min
  
diff --ignore-blank-lines --context=3 -r oldgcm/callradite.F oldmeso/callradite.F
*** oldgcm/callradite.F	Tue Feb  2 15:41:20 2010
--- oldmeso/callradite.F	Tue Jan 25 16:49:09 2011
***************
*** 20,28 ****
  c
  c   The purpose of this subroutine is to:
  c      1) Make some initial calculation at first call
! c      2) Compute the 3D scattering parameters depending on the
  c        size distribution of the different tracers (added by JBM)
! c      3) call "lwmain" and "swmain"
  c
  c
  c   authors:   
--- 20,32 ----
  c
  c   The purpose of this subroutine is to:
  c      1) Make some initial calculation at first call
! c      2) Split the calculation in several sub-grid
! c        ("sub-domain") to save memory and
! c        be able run on a workstation at high resolution
! c        The sub-grid size is defined in dimradmars.h
! c      3) Compute the 3D scattering parameters depending on the
  c        size distribution of the different tracers (added by JBM)
! c      4) call "lwmain" and "swmain"
  c
  c
  c   authors:   
***************
*** 73,81 ****
  c   In other routines, nlayermx -> nflev.
  c   Routines affected: lwflux, lwi, lwmain, lwxb, lwxd, lwxn.
  c
! c   > J.-B. Madeleine 09W30
! c
! c   Removed the variable's splitting, which is now obsolete.
  c
  c   ----------
  c   Here, solar band#1 is spectral interval between "long1vis" and "long2vis"
--- 77,85 ----
  c   In other routines, nlayermx -> nflev.
  c   Routines affected: lwflux, lwi, lwmain, lwxb, lwxd, lwxn.
  c
! c   > J.-B. Madeleine 10W12
! c   This version uses the variable's splitting, which can be usefull
! c     when performing very high resolution simulation like LES.
  c
  c   ----------
  c   Here, solar band#1 is spectral interval between "long1vis" and "long2vis"
***************
*** 174,191 ****
  c    Local variables :
  c    -----------------
  
!       INTEGER j,l,ig,n
  
        real  cste_mars ! solar constant on Mars (Wm-2)
        REAL ptlev(ngridmx,nlayermx+1)
!       REAL dp(ngrid,nflev)
!       REAL dt0(ngrid)
  
  c     Thermal IR net radiative budget (W m-2)
  
!       REAL netrad(ngrid,nflev) 
!       REAL fluxd_sw(ngrid,nflev+1,2)
!       REAL fluxu_sw(ngrid,nflev+1,2)
  
  c     Aerosol size distribution
        REAL :: reffrad(ngrid,nlayer,naerkind)
--- 178,220 ----
  c    Local variables :
  c    -----------------
  
!       INTEGER j,l,ig,n,ich,iaer
!       INTEGER jd,ig0,nd
  
        real  cste_mars ! solar constant on Mars (Wm-2)
        REAL ptlev(ngridmx,nlayermx+1)
! 
!       INTEGER ndomain
!       parameter (ndomain = (ngridmx-1) / ndomainsz + 1)
  
  c     Thermal IR net radiative budget (W m-2)
  
!       real znetrad(ndomainsz,nflev)
! 
!       real zfluxd_sw(ndomainsz,nflev+1,2)
!       real zfluxu_sw(ndomainsz,nflev+1,2)
! 
!       REAL zplev(ndomainsz,nflev+1)
!       REAL zztlev(ndomainsz,nflev+1)
!       REAL zplay(ndomainsz,nflev)
!       REAL zt(ndomainsz,nflev)
!       REAL zaerosol(ndomainsz,nflev,naerkind)
!       REAL zalbedo(ndomainsz,2)
!       REAL zdp(ndomainsz,nflev)
!       REAL zdt0(ndomainsz)
! 
!       REAL zzdtlw(ndomainsz,nflev)
!       REAL zzdtsw(ndomainsz,nflev)
!       REAL zzflux(ndomainsz,6)
!       real zrmuz
! 
!       REAL :: zQVISsQREF3d(ndomainsz,nflev,nsun,naerkind)
!       REAL :: zomegaVIS3d(ndomainsz,nflev,nsun,naerkind)
!       REAL :: zgVIS3d(ndomainsz,nflev,nsun,naerkind)
! 
!       REAL :: zQIRsQREF3d(ndomainsz,nflev,nir,naerkind)
!       REAL :: zomegaIR3d(ndomainsz,nflev,nir,naerkind)
!       REAL :: zgIR3d(ndomainsz,nflev,nir,naerkind)
  
  c     Aerosol size distribution
        REAL :: reffrad(ngrid,nlayer,naerkind)
***************
*** 249,254 ****
--- 278,296 ----
           CALL SUAER
           CALL SULW
  
+          write(*,*) 'Splitting radiative calculations: ',
+      $              ' ngridmx,ngrid,ndomainsz,ndomain',
+      $                ngridmx,ngrid,ndomainsz,ndomain
+          if (ngridmx .EQ. 1) then
+            if (ndomainsz .NE. 1) then
+              print*
+              print*,'ATTENTION !!!'
+              print*,'pour tourner en 1D, '
+              print*,'fixer ndomainsz=1 dans phymars/dimradmars.h'
+              print*
+              call exit(1)
+            endif
+          endif
           firstcall=.false.
        END IF
  
***************
*** 273,315 ****
       &      tauref,tau,aerosol,reffrad,
       &      QREFvis3d,QREFir3d,omegaREFvis3d,omegaREFir3d)
  
          do l=1,nlaylte
!          do ig = 1, ngrid
  c         Thickness of each layer (Pa) :
!           dp(ig,l)= pplev(ig,l) - pplev(ig,l+1)
           enddo
          enddo
  
  c       Intermediate  levels: (computing tlev)
  c       ---------------------------------------
  c       Extrapolation for the air temperature above the surface
!         DO ig=1, ngrid
!               ptlev(ig,1)=pt(ig,1)+
!      s        (pplev(ig,1)-pplay(ig,1))*
!      s        (pt(ig,1)-pt(ig,2))/(pplay(ig,1)-pplay(ig,2))
  
!               dt0(ig) = tsurf(ig) - ptlev(ig,1)
          ENDDO
  
          DO l=2,nlaylte
!          DO ig=1, ngrid
!                ptlev(ig,l)=0.5*(pt(ig,l-1)+pt(ig,l))
           ENDDO
          ENDDO
  
!         DO ig=1, ngrid
!            ptlev(ig,nlaylte+1)=pt(ig,nlaylte)
          ENDDO
  
  
  c       Longwave ("lw") radiative transfer (= thermal infrared)
  c       -------------------------------------------------------
!         call lwmain (icount,ngrid,nflev
!      .        ,dp,dt0,emis,pplev,ptlev,pt
!      .        ,aerosol,dtlw
!      .        ,fluxsurf_lw,fluxtop_lw
!      .        ,netrad
!      &        ,QIRsQREF3d,omegaIR3d,gIR3d)
  
  c       Shortwave ("sw") radiative transfer (= solar radiation)
  c       -------------------------------------------------------
--- 315,416 ----
       &      tauref,tau,aerosol,reffrad,
       &      QREFvis3d,QREFir3d,omegaREFvis3d,omegaREFir3d)
  
+ c     Starting loop on sub-domain
+ c     ----------------------------
+ 
+       DO jd=1,ndomain
+         ig0=(jd-1)*ndomainsz
+         if (jd.eq.ndomain) then
+          nd=ngridmx-ig0
+         else
+          nd=ndomainsz
+         endif
+ 
+ c       Spliting input variable in sub-domain input variables
+ c       ---------------------------------------------------
+ 
+         do l=1,nlaylte
+          do ig = 1,nd
+            do iaer = 1, naerkind
+              do ich = 1, nsun
+                zQVISsQREF3d(ig,l,ich,iaer) = 
+      &                           QVISsQREF3d(ig0+ig,l,ich,iaer)
+                zomegaVIS3d(ig,l,ich,iaer) = 
+      &                           omegaVIS3d(ig0+ig,l,ich,iaer)
+                zgVIS3d(ig,l,ich,iaer) = 
+      &                           gVIS3d(ig0+ig,l,ich,iaer)
+              enddo
+              do ich = 1, nir
+                zQIRsQREF3d(ig,l,ich,iaer) = 
+      &                           QIRsQREF3d(ig0+ig,l,ich,iaer)
+                zomegaIR3d(ig,l,ich,iaer) = 
+      &                           omegaIR3d(ig0+ig,l,ich,iaer)
+                zgIR3d(ig,l,ich,iaer) = 
+      &                           gIR3d(ig0+ig,l,ich,iaer)
+              enddo
+            enddo
+          enddo
+         enddo
+ 
+         do l=1,nlaylte+1
+          do ig = 1,nd
+           zplev(ig,l) = pplev(ig0+ig,l)
+          enddo
+         enddo
+ 
          do l=1,nlaylte
!          do ig = 1,nd
!           zplay(ig,l) = pplay(ig0+ig,l)
!           zt(ig,l) = pt(ig0+ig,l)
  c         Thickness of each layer (Pa) :
!           zdp(ig,l)= pplev(ig0+ig,l) - pplev(ig0+ig,l+1)
           enddo
          enddo
  
+         do n=1,naerkind
+           do l=1,nlaylte
+             do ig=1,nd
+               zaerosol(ig,l,n) = aerosol(ig0+ig,l,n)
+             enddo
+           enddo
+         enddo
+ 
+         do j=1,2
+           do ig = 1,nd
+            zalbedo(ig,j) = albedo(ig0+ig,j)
+           enddo
+         enddo
+ 
  c       Intermediate  levels: (computing tlev)
  c       ---------------------------------------
  c       Extrapolation for the air temperature above the surface
!         DO ig=1,nd
!               zztlev(ig,1)=zt(ig,1)+
!      s        (zplev(ig,1)-zplay(ig,1))*
!      s        (zt(ig,1)-zt(ig,2))/(zplay(ig,1)-zplay(ig,2))
  
!               zdt0(ig) = tsurf(ig0+ig) - zztlev(ig,1)
          ENDDO
  
          DO l=2,nlaylte
!          DO ig=1, nd
!                zztlev(ig,l)=0.5*(zt(ig,l-1)+zt(ig,l)) 
           ENDDO
          ENDDO
  
!         DO ig=1, nd
!            zztlev(ig,nlaylte+1)=zt(ig,nlaylte)
          ENDDO
  
  
  c       Longwave ("lw") radiative transfer (= thermal infrared)
  c       -------------------------------------------------------
!         call lwmain (ig0,icount,nd,nflev
!      .        ,zdp,zdt0,emis(ig0+1),zplev,zztlev,zt
!      .        ,zaerosol,zzdtlw
!      .        ,fluxsurf_lw(ig0+1),fluxtop_lw(ig0+1)
!      .        ,znetrad
!      &        ,zQIRsQREF3d,zomegaIR3d,zgIR3d)
  
  c       Shortwave ("sw") radiative transfer (= solar radiation)
  c       -------------------------------------------------------
***************
*** 317,337 ****
  c          1370 W.m-2 is the solar constant at 1 AU.
             cste_mars=1370./(dist_sol*dist_sol)
  
!            call swmain ( ngrid, nflev, 
!      S     cste_mars, albedo, 
!      S     mu0, dp, pplev, aerosol, fract,
!      S     dtsw, fluxd_sw, fluxu_sw,
!      &     QVISsQREF3d,omegaVIS3d,gVIS3d)
  
  c       ------------------------------------------------------------
  
!         do ig = 1, ngrid
!           fluxsurf_sw(ig,1) = fluxd_sw(ig,1,1)
!           fluxsurf_sw(ig,2) = fluxd_sw(ig,1,2)
!           fluxtop_sw(ig,1) = fluxu_sw(ig,nlaylte+1,1)
!           fluxtop_sw(ig,2) = fluxu_sw(ig,nlaylte+1,2)
          enddo
  
  c     Zero tendencies for any remaining layers between nlaylte and nlayer
        if (nlayer.gt.nlaylte) then
           do l = nlaylte+1, nlayer
--- 418,455 ----
  c          1370 W.m-2 is the solar constant at 1 AU.
             cste_mars=1370./(dist_sol*dist_sol)
  
!            call swmain ( nd, nflev,
!      S     cste_mars, zalbedo,
!      S     mu0(ig0+1), zdp, zplev, zaerosol, fract(ig0+1),
!      S     zzdtsw, zfluxd_sw, zfluxu_sw,
!      &     zQVISsQREF3d,zomegaVIS3d,zgVIS3d)
  
  c       ------------------------------------------------------------
+ c       Un-spliting output variable from sub-domain input variables
+ c       ------------------------------------------------------------
+ 
+         do l=1,nlaylte
+          do ig = 1,nd
+           dtlw(ig0+ig,l) = zzdtlw(ig,l)
+           dtsw(ig0+ig,l) = zzdtsw(ig,l)
+          enddo
+         enddo
  
!         do l=1,nlaylte+1
!          do ig = 1,nd
!           ptlev(ig0+ig,l) = zztlev(ig,l)
!          enddo
          enddo
  
+         do ig = 1,nd
+           fluxsurf_sw(ig0+ig,1) = zfluxd_sw(ig,1,1)
+           fluxsurf_sw(ig0+ig,2) = zfluxd_sw(ig,1,2)
+           fluxtop_sw(ig0+ig,1) = zfluxu_sw(ig,nlaylte+1,1)
+           fluxtop_sw(ig0+ig,2) = zfluxu_sw(ig,nlaylte+1,2)
+         enddo
+ 
+       ENDDO         !   (boucle jd=1, ndomain)
+ 
  c     Zero tendencies for any remaining layers between nlaylte and nlayer
        if (nlayer.gt.nlaylte) then
           do l = nlaylte+1, nlayer
Only in oldgcm: callradite.F.old
Only in oldmeso: callradite.F~
diff --ignore-blank-lines --context=3 -r oldgcm/datafile.h oldmeso/datafile.h
*** oldgcm/datafile.h	Thu Sep 23 18:53:00 2010
--- oldmeso/datafile.h	Mon Jan 24 12:16:55 2011
***************
*** 4,11 ****
  !  Address of the directory containing tables of data needed by the GCM    
  
        character (len=100) :: datafile
! !      data datafile /'/u/forget/WWW/datagcm/datafile'/
! !!     data datafile /'/home/forget/datafile'/
!       data datafile /'/d2/emlmd/work_TASI/dust_scenarios_new/flush/LMDZ.&
!      &MARS.BETA/datafile'/
  !-----------------------------------------------------------------------
--- 4,10 ----
  !  Address of the directory containing tables of data needed by the GCM    
  
        character (len=100) :: datafile
! !! path to WRF data
!        data datafile /'/u/forget/WWW/datagcm/datafile'/
! !       data datafile /'/d5/aslmd/LMD_MM_MARS_DATA/dust'/
  !-----------------------------------------------------------------------
Only in oldmeso: diff.cmd
Only in oldmeso: diff.cmd~
Only in oldmeso: diff.log
Only in oldmeso: diff.log.h
diff --ignore-blank-lines --context=3 -r oldgcm/dimphys.h oldmeso/dimphys.h
*** oldgcm/dimphys.h	Tue Feb  2 15:41:20 2010
--- oldmeso/dimphys.h	Tue Jan 25 16:49:09 2011
***************
*** 1,12 ****
  !-----------------------------------------------------------------------
  !   INCLUDE 'dimphys.h'
  
! ! ngridmx : number of horizontal grid points
! ! note: the -1/jjm term will be 0; unless jj=1
!       integer, parameter :: ngridmx = (2+(jjm-1)*iim - 1/jjm)   
! ! nlayermx : number of atmospheric layers
!       integer, parameter :: nlayermx = llm 
! ! nsoilmx : number of subterranean layers
! !EM: old soil routine:      integer, parameter :: nsoilmx = 10
!       integer, parameter :: nsoilmx = 18 
  !-----------------------------------------------------------------------
--- 1,13 ----
  !-----------------------------------------------------------------------
  !   INCLUDE 'dimphys.h'
  
! 
!          INTEGER, parameter :: wiim=60
!          INTEGER, parameter :: wjjm=60
!          INTEGER, PARAMETER :: ngridmx=3600
!          INTEGER, parameter :: nlayermx=60
!          INTEGER, PARAMETER :: nsoilmx=10
! 	
  !-----------------------------------------------------------------------
+ 
+ 	 
diff --ignore-blank-lines --context=3 -r oldgcm/dimradmars.h oldmeso/dimradmars.h
*** oldgcm/dimradmars.h	Tue Feb  2 15:41:20 2010
--- oldmeso/dimradmars.h	Tue Jan 25 16:49:09 2011
***************
*** 8,17 ****
  
  ! nflev: number of vertical layer
  ! ndlon,ndlo2: number of horizontal points
  
!       INTEGER  NFLEV,NDLON,NDLO2
  
!       parameter (NFLEV=nlayermx,NDLON=ngridmx)
        parameter (NDLO2=NDLON)
  
  ! Number of kind of tracer radiative properties 
--- 8,24 ----
  
  ! nflev: number of vertical layer
  ! ndlon,ndlo2: number of horizontal points
+ ! Splitting of horizontal grid
+ ! NDLO2 et ndomainsz pour le decoupage de l'appel a la physique
+ ! ATTENTION:  Il faut  1 < ndomainsz =< ngridmx
  
!       INTEGER  NFLEV,NDLON,NDLO2,ndomainsz
  
! !     parameter (ndomainsz=ngridmx)
!       parameter (ndomainsz=(ngridmx-1)/20 + 1)
! !     parameter (ndomainsz=(ngridmx-1)/5 + 1) 
! 
!       parameter (NFLEV=nlayermx,NDLON=ndomainsz) ! avec decoupage
        parameter (NDLO2=NDLON)
  
  ! Number of kind of tracer radiative properties 
Only in oldgcm: drag_noro.F
diff --ignore-blank-lines --context=3 -r oldgcm/dustlift.F oldmeso/dustlift.F
*** oldgcm/dustlift.F	Tue Feb  2 15:41:20 2010
--- oldmeso/dustlift.F	Tue Jan 25 16:49:09 2011
***************
*** 1,4 ****
!       SUBROUTINE dustlift(ngrid,nlay,nq,rho,pcdh_true,pcdh,co2ice,
       $                  dqslift)
        IMPLICIT NONE
  
--- 1,5 ----
!       SUBROUTINE dustlift(ngrid,nlay,nq,rho,
!      $                  pcdh_true,pcdh,co2ice,
       $                  dqslift)
        IMPLICIT NONE
  
***************
*** 41,47 ****
        REAL ust,us
        REAL stress_seuil
        SAVE stress_seuil
!       DATA stress_seuil/0.0225/   ! stress seuil soulevement (N.m2)
  
  
  c     ---------------------------------
--- 42,69 ----
        REAL ust,us
        REAL stress_seuil
        SAVE stress_seuil
! c      DATA stress_seuil/0.0225/   ! stress seuil soulevement (N.m2)
! !****WRF
! !****WRF: additional ASCII file to define dust opacity
!           REAL alpha
!           INTEGER ierr
!           OPEN(99,file='stress.def',status='old',form='formatted'
!      .     ,iostat=ierr)
!           IF(ierr.NE.0) THEN
!              stress_seuil = 0.0225
!              alpha = 1.
!              write(*,*) 'No file stress.def - set ', stress_seuil, alpha
!              !stop
!           ELSE
!              READ(99,*) stress_seuil
!              READ(99,*) alpha
!              write(*,*) 'definir seuil stress : ', stress_seuil, alpha
!              CLOSE(99)
!           ENDIF
!           alpha_lift(1) = alpha
! !****WRF
! !****WRF
! 
  
  
  c     ---------------------------------
Only in oldmeso: gr_fi_dyn.F
Only in oldgcm: gwprofil.F
Only in oldgcm: gwstress.F
Only in oldgcm: inifis.F
Only in oldgcm: inifis.F~
diff --ignore-blank-lines --context=3 -r oldgcm/initracer.F oldmeso/initracer.F
*** oldgcm/initracer.F	Thu Feb  4 10:47:02 2010
--- oldmeso/initracer.F	Tue Jan 25 16:49:09 2011
***************
*** 43,50 ****
  #include "advtrac.h"
  #include "comgeomfi.h"
  #include "watercap.h"
! #include "chimiedata.h"
! 
  
        real qsurf(ngridmx,nqmx)       ! tracer on surface (e.g.  kg.m-2)
        real co2ice(ngridmx)           ! co2 ice mass on surface (e.g.  kg.m-2)
--- 43,49 ----
  #include "advtrac.h"
  #include "comgeomfi.h"
  #include "watercap.h"
! #include "chimiedata.h"  
  
        real qsurf(ngridmx,nqmx)       ! tracer on surface (e.g.  kg.m-2)
        real co2ice(ngridmx)           ! co2 ice mass on surface (e.g.  kg.m-2)
***************
*** 436,443 ****
              Qext(iq)=0.
              alpha_lift(iq) =0.
              alpha_devil(iq)=0.
! 	    qextrhor(iq)= 0.
!           endif
          enddo ! do iq=1,nqmx
        endif
  
--- 435,442 ----
              Qext(iq)=0.
              alpha_lift(iq) =0.
              alpha_devil(iq)=0.
!             qextrhor(iq)= 0.
!          endif
          enddo ! do iq=1,nqmx
        endif
  
***************
*** 448,454 ****
           Qext(igcm_h2o_vap)=0.
           alpha_lift(igcm_h2o_vap) =0.
           alpha_devil(igcm_h2o_vap)=0.
! 	 qextrhor(igcm_h2o_vap)= 0.
  
  c       "Dryness coefficient" controlling the evaporation and
  c        sublimation from the ground water ice (close to 1)
--- 447,453 ----
           Qext(igcm_h2o_vap)=0.
           alpha_lift(igcm_h2o_vap) =0.
           alpha_devil(igcm_h2o_vap)=0.
!          qextrhor(igcm_h2o_vap)= 0.
  
  c       "Dryness coefficient" controlling the evaporation and
  c        sublimation from the ground water ice (close to 1)
Only in oldmeso: jb_phymars
diff --ignore-blank-lines --context=3 -r oldgcm/lwflux.F oldmeso/lwflux.F
*** oldgcm/lwflux.F	Tue Feb  2 15:41:20 2010
--- oldmeso/lwflux.F	Tue Jan 25 16:49:09 2011
***************
*** 1,4 ****
!        subroutine lwflux (kdlon,kflev,dp
       .                   ,bsurf,btop,blev,blay,dbsublay
       .                   ,tlay, tlev, dt0      ! pour sortie dans g2d uniquement
       .                   ,emis
--- 1,4 ----
!        subroutine lwflux (ig0,kdlon,kflev,dp
       .                   ,bsurf,btop,blev,blay,dbsublay
       .                   ,tlay, tlev, dt0      ! pour sortie dans g2d uniquement
       .                   ,emis
***************
*** 26,31 ****
--- 26,32 ----
  c               ---------
  c                                                            inputs:
  c                                                            -------
+       integer ig0
        integer kdlon                 ! part of ngrid
        integer kflev                 ! part of nlayer
  
***************
*** 62,68 ****
  c         0.2   local arrays
  c               ------------
  
!       integer ja,jl,j,i,ig1d,l,ndim
        parameter(ndim = ndlon*(nuco2+1)*(nflev+2)*(nflev+2))
        real  ksidb (ndlon,nuco2+1,0:nflev+1,0:nflev+1) ! net exchange rate (W/m2)
  
--- 63,69 ----
  c         0.2   local arrays
  c               ------------
  
!       integer ja,jl,j,i,ig1d,ig,l,ndim
        parameter(ndim = ndlon*(nuco2+1)*(nflev+2)*(nflev+2))
        real  ksidb (ndlon,nuco2+1,0:nflev+1,0:nflev+1) ! net exchange rate (W/m2)
  
***************
*** 91,97 ****
            do ja = 1,nuco2
              do jl = 1,kdlon
  
!       ksidb(jl,ja,i,j) = xi(jl,ja,i,j) 
       .                 * (blay(jl,ja,j)-blay(jl,ja,i))
  c                                                        ksidb reciprocity
  c                                                        -----------------
--- 92,98 ----
            do ja = 1,nuco2
              do jl = 1,kdlon
  
!       ksidb(jl,ja,i,j) = xi(ig0+jl,ja,i,j)
       .                 * (blay(jl,ja,j)-blay(jl,ja,i))
  c                                                        ksidb reciprocity
  c                                                        -----------------
***************
*** 110,116 ****
          do ja = 1,nuco2
            do jl = 1,kdlon
  
!       ksidb(jl,ja,i,0) = xi(jl,ja,0,i) 
       .                 * (bsurf(jl,ja)-blay(jl,ja,i))
  c                                                        ksidb reciprocity
  c                                                        -----------------
--- 111,117 ----
          do ja = 1,nuco2
            do jl = 1,kdlon
  
!       ksidb(jl,ja,i,0) = xi(ig0+jl,ja,0,i)
       .                 * (bsurf(jl,ja)-blay(jl,ja,i))
  c                                                        ksidb reciprocity
  c                                                        -----------------
***************
*** 129,135 ****
            do jl = 1,kdlon
  
        ksidb(jl,ja,1,0) = ksidb(jl,ja,1,0) 
!      .                 - xi_ground(jl,ja) 
       .                 * (blev(jl,ja,1)-blay(jl,ja,1))
  
  cc                                                       ksidb reciprocity
--- 130,136 ----
            do jl = 1,kdlon
  
        ksidb(jl,ja,1,0) = ksidb(jl,ja,1,0) 
!      .                 - xi_ground(ig0+jl,ja)
       .                 * (blev(jl,ja,1)-blay(jl,ja,1))
  
  cc                                                       ksidb reciprocity
***************
*** 147,153 ****
          do ja = 1,nuco2
            do jl = 1,kdlon
  
!       ksidb(jl,ja,i,nlaylte+1) = xi(jl,ja,i,nlaylte+1) 
       .                       * (-blay(jl,ja,i))
  c                                                        ksidb reciprocity
  c                                                        -----------------
--- 148,154 ----
          do ja = 1,nuco2
            do jl = 1,kdlon
  
!       ksidb(jl,ja,i,nlaylte+1) = xi(ig0+jl,ja,i,nlaylte+1) 
       .                       * (-blay(jl,ja,i))
  c                                                        ksidb reciprocity
  c                                                        -----------------
***************
*** 164,170 ****
        do ja = 1,nuco2
          do jl = 1,kdlon
  
!       ksidb(jl,ja,0,nlaylte+1) = xi(jl,ja,0,nlaylte+1) 
       .                       * (-bsurf(jl,ja))
  
  c                                                        ksidb reciprocity
--- 165,171 ----
        do ja = 1,nuco2
          do jl = 1,kdlon
  
!       ksidb(jl,ja,0,nlaylte+1) = xi(ig0+jl,ja,0,nlaylte+1) 
       .                       * (-bsurf(jl,ja))
  
  c                                                        ksidb reciprocity
***************
*** 259,265 ****
            do jl = 1,kdlon
  
        fluxground(jl) = fluxground(jl)
!      .               + xi(jl,ja,0,i) * (blay(jl,ja,i))
  
            enddo
          enddo
--- 260,266 ----
            do jl = 1,kdlon
  
        fluxground(jl) = fluxground(jl)
!      .               + xi(ig0+jl,ja,0,i) * (blay(jl,ja,i))
  
            enddo
          enddo
***************
*** 305,311 ****
            do jl = 1,kdlon
              coefu(jl,ja,i,j) =0.
              do l=j,nlaylte+1 
!               coefu(jl,ja,i,j)=coefu(jl,ja,i,j)+xi(jl,ja,l,i)
              end do
  
            enddo
--- 306,312 ----
            do jl = 1,kdlon
              coefu(jl,ja,i,j) =0.
              do l=j,nlaylte+1 
!               coefu(jl,ja,i,j)=coefu(jl,ja,i,j)+xi(ig0+jl,ja,l,i)
              end do
  
            enddo
***************
*** 333,339 ****
            do jl = 1,kdlon
              coefd(jl,ja,i,j) =0.
              do l=0,j-1
!               coefd(jl,ja,i,j)=coefd(jl,ja,i,j)+xi(jl,ja,l,i)
              end do
            enddo
           enddo
--- 334,340 ----
            do jl = 1,kdlon
              coefd(jl,ja,i,j) =0.
              do l=0,j-1
!               coefd(jl,ja,i,j)=coefd(jl,ja,i,j)+xi(ig0+jl,ja,l,i)
              end do
            enddo
           enddo
***************
*** 357,362 ****
--- 358,364 ----
  c               ----------------
  
  c ig1d: point de la grille physique ou on veut faire la sortie
+ c ig0+1:  point du decoupage de la grille physique
  
  c#ifdef undim
        if (callg2d) then
***************
*** 364,370 ****
        ig1d = ngridmx/2 + 1
  c     ig1d = ngridmx
  
!       print*, 'Sortie g2d: ig1d =', ig1d
  
  c--------------------------------------------
  c   Ouverture de g2d.dat
--- 366,376 ----
        ig1d = ngridmx/2 + 1
  c     ig1d = ngridmx
  
!       if ((ig0+1).LE.ig1d .and. ig1d.LE.(ig0+kdlon)
!      .    .OR.  ngridmx.EQ.1   ) then
! 
!           ig = ig1d-ig0
!         print*, 'Sortie g2d: ig1d, ig, ig0', ig1d, ig, ig0
  
  c--------------------------------------------
  c   Ouverture de g2d.dat
***************
*** 403,409 ****
          do j = 0,nlaylte+1
            do i = 0,nlaylte+1
              g2d_irec=g2d_irec+1
!             reel4 = ksidb(ig1d,ja,i,j)
              write(47,rec=g2d_irec) reel4
            enddo
          enddo
--- 409,415 ----
          do j = 0,nlaylte+1
            do i = 0,nlaylte+1
              g2d_irec=g2d_irec+1
!             reel4 = ksidb(ig,ja,i,j)
              write(47,rec=g2d_irec) reel4
            enddo
          enddo
***************
*** 412,418 ****
        do j = 0,nlaylte+1
          do i = 0,nlaylte+1
            g2d_irec=g2d_irec+1
!           reel4 = ksidb(ig1d,3,i,j)
            write(47,rec=g2d_irec) reel4
          enddo
        enddo
--- 418,424 ----
        do j = 0,nlaylte+1
          do i = 0,nlaylte+1
            g2d_irec=g2d_irec+1
!           reel4 = ksidb(ig,3,i,j)
            write(47,rec=g2d_irec) reel4
          enddo
        enddo
***************
*** 423,429 ****
  
          do j = 1 , nlaylte
            do i = 0 , nlaylte+1
!             dpsgcp(i,j) = dp(ig1d,j) / gcp
            enddo
          enddo
  
--- 429,435 ----
  
          do j = 1 , nlaylte
            do i = 0 , nlaylte+1
!             dpsgcp(i,j) = dp(ig,j) / gcp
            enddo
          enddo
  
***************
*** 437,443 ****
  c     print*,'gcp: ',gcp
  c     print*
  c       do i = 0 , nlaylte+1
! c     print*,i,'dp: ',dp(ig1d,i)
  c       enddo
  c     print*
  c       do i = 0 , nlaylte+1
--- 443,449 ----
  c     print*,'gcp: ',gcp
  c     print*
  c       do i = 0 , nlaylte+1
! c     print*,i,'dp: ',dp(ig,i)
  c       enddo
  c     print*
  c       do i = 0 , nlaylte+1
***************
*** 458,469 ****
  
          do j = 1 , nlaylte
            do i = 0 , nlaylte+1
!             temp(i,j) = tlay(ig1d,j)
            enddo
          enddo
  
          do i = 0 , nlaylte+1
!           temp(i,0) = tlev(ig1d,1)+dt0(ig1d)     ! temperature surface
            temp(i,nlaylte+1) = 0.               ! temperature espace  (=0)
          enddo
  
--- 464,475 ----
  
          do j = 1 , nlaylte
            do i = 0 , nlaylte+1
!             temp(i,j) = tlay(ig,j)
            enddo
          enddo
  
          do i = 0 , nlaylte+1
!           temp(i,0) = tlev(ig,1)+dt0(ig)     ! temperature surface
            temp(i,nlaylte+1) = 0.               ! temperature espace  (=0)
          enddo
  
***************
*** 475,503 ****
          enddo
        enddo
  
!         write(76,*) 'ig1d =', ig1d
          write(76,*) 'nlaylte', nlaylte
          write(76,*) 'nflev', nflev
          write(76,*) 'kdlon', kdlon
          write(76,*) 'ndlo2', ndlo2
          write(76,*) 'ndlon', ndlon
        do ja=1,4
!         write(76,*) 'bsurf', ja, bsurf(ig1d,ja)
!         write(76,*) 'btop', ja, btop(ig1d,ja)
  
          do j=1,nlaylte+1
!           write(76,*) 'blev', ja, j, blev(ig1d,ja,j)
          enddo
  
          do j=1,nlaylte
!           write(76,*) 'blay', ja, j, blay(ig1d,ja,j)
          enddo
  
          do j=1,2*nlaylte
!           write(76,*) 'dbsublay', ja, j, dbsublay(ig1d,ja,j)
          enddo
        enddo
  
  c************************************************************************
  c#endif 
        endif  !   callg2d
--- 481,510 ----
          enddo
        enddo
  
!         write(76,*) 'ig1d, ig, ig0', ig1d, ig, ig0
          write(76,*) 'nlaylte', nlaylte
          write(76,*) 'nflev', nflev
          write(76,*) 'kdlon', kdlon
          write(76,*) 'ndlo2', ndlo2
          write(76,*) 'ndlon', ndlon
        do ja=1,4
!         write(76,*) 'bsurf', ja, bsurf(ig,ja)
!         write(76,*) 'btop', ja, btop(ig,ja)
  
          do j=1,nlaylte+1
!           write(76,*) 'blev', ja, j, blev(ig,ja,j)
          enddo
  
          do j=1,nlaylte
!           write(76,*) 'blay', ja, j, blay(ig,ja,j)
          enddo
  
          do j=1,2*nlaylte
!           write(76,*) 'dbsublay', ja, j, dbsublay(ig,ja,j)
          enddo
        enddo
  
+       endif
  c************************************************************************
  c#endif 
        endif  !   callg2d
diff --ignore-blank-lines --context=3 -r oldgcm/lwi.F oldmeso/lwi.F
*** oldgcm/lwi.F	Tue Feb  2 15:41:20 2010
--- oldmeso/lwi.F	Tue Jan 25 16:49:09 2011
***************
*** 1,4 ****
!       subroutine lwi (kdlon,kflev
       .                ,psi,zdblay,pdp
       .                ,newpcolc )
  
--- 1,4 ----
!       subroutine lwi (ig0,kdlon,kflev
       .                ,psi,zdblay,pdp
       .                ,newpcolc )
  
***************
*** 34,40 ****
  c              ---------
  c
   
!       integer kdlon,kflev
  
        real    psi(ndlo2,kflev)
       .     ,  zdblay(ndlo2,nir,kflev)
--- 34,40 ----
  c              ---------
  c
   
!       integer ig0,kdlon,kflev
  
        real    psi(ndlo2,kflev)
       .     ,  zdblay(ndlo2,nir,kflev)
***************
*** 90,103 ****
          do jl = 1 , kdlon
  c     -------------------
        di(jl,i) =  1 + semit * (g / pdp(jl,i) / cpp) * (
!      .    ( xi(jl,1,i,nlaylte+1) 
!      .    + xi(jl,1,i,i+1) 
!      .    + xi(jl,1,i,i-1) )
!      .    *    zdblay(jl,1,i) 
!      .  + ( xi(jl,2,i,nlaylte+1) 
!      .    + xi(jl,2,i,i+1) 
!      .    + xi(jl,2,i,i-1) )
!      .    *    zdblay(jl,2,i) 
       .     )
  c     -------------------
          enddo
--- 90,103 ----
          do jl = 1 , kdlon
  c     -------------------
        di(jl,i) =  1 + semit * (g / pdp(jl,i) / cpp) * (
!      .    ( xi(ig0+jl,1,i,nlaylte+1)
!      .    + xi(ig0+jl,1,i,i+1)
!      .    + xi(ig0+jl,1,i,i-1) )
!      .    *    zdblay(jl,1,i)
!      .  + ( xi(ig0+jl,2,i,nlaylte+1)
!      .    + xi(ig0+jl,2,i,i+1)
!      .    + xi(ig0+jl,2,i,i-1) )
!      .    *    zdblay(jl,2,i)
       .     )
  c     -------------------
          enddo
***************
*** 112,123 ****
        do jl = 1 , kdlon
  c     -------------------
        di(jl,nlaylte) =  1 + semit * (g / pdp(jl,nlaylte) / cpp) * (
!      .    ( xi(jl,1,nlaylte,nlaylte+1) 
!      .    + xi(jl,1,nlaylte,nlaylte-1) )
!      .    *    zdblay(jl,1,nlaylte) 
!      .  + ( xi(jl,2,nlaylte,nlaylte+1) 
!      .    + xi(jl,2,nlaylte,nlaylte-1) )
!      .    *    zdblay(jl,2,nlaylte) 
       .     )
  c     -------------------
        enddo
--- 110,121 ----
        do jl = 1 , kdlon
  c     -------------------
        di(jl,nlaylte) =  1 + semit * (g / pdp(jl,nlaylte) / cpp) * (
!      .    ( xi(ig0+jl,1,nlaylte,nlaylte+1)
!      .    + xi(ig0+jl,1,nlaylte,nlaylte-1) )
!      .    *    zdblay(jl,1,nlaylte)
!      .  + ( xi(ig0+jl,2,nlaylte,nlaylte+1)
!      .    + xi(ig0+jl,2,nlaylte,nlaylte-1) )
!      .    *    zdblay(jl,2,nlaylte)
       .     )
  c     -------------------
        enddo
***************
*** 132,139 ****
          do jl = 1 , kdlon
  c     -------------------
        hi(jl,i) =    - semit * (g / pdp(jl,i) / cpp) *
!      .            (    xi(jl,1,i,i+1) * zdblay(jl,1,i+1)
!      .               + xi(jl,2,i,i+1) * zdblay(jl,2,i+1)   )
  c     -------------------
          enddo
        enddo
--- 129,136 ----
          do jl = 1 , kdlon
  c     -------------------
        hi(jl,i) =    - semit * (g / pdp(jl,i) / cpp) *
!      .            (    xi(ig0+jl,1,i,i+1) * zdblay(jl,1,i+1)   
!      .               + xi(ig0+jl,2,i,i+1) * zdblay(jl,2,i+1)   )
  c     -------------------
          enddo
        enddo
***************
*** 148,155 ****
          do jl = 1 , kdlon
  c     -------------------
        bi(jl,i) =   - semit * (g / pdp(jl,i) / cpp) * 
!      .           (     xi(jl,1,i,i-1) * zdblay(jl,1,i-1)
!      .               + xi(jl,2,i,i-1) * zdblay(jl,2,i-1)   )
  c     -------------------
          enddo
        enddo
--- 145,152 ----
          do jl = 1 , kdlon
  c     -------------------
        bi(jl,i) =   - semit * (g / pdp(jl,i) / cpp) * 
!      .           (     xi(ig0+jl,1,i,i-1) * zdblay(jl,1,i-1)   
!      .               + xi(ig0+jl,2,i,i-1) * zdblay(jl,2,i-1)   )
  c     -------------------
          enddo
        enddo
diff --ignore-blank-lines --context=3 -r oldgcm/lwmain.F oldmeso/lwmain.F
*** oldgcm/lwmain.F	Tue Feb  2 15:41:20 2010
--- oldmeso/lwmain.F	Tue Jan 25 16:49:09 2011
***************
*** 1,4 ****
!        subroutine lwmain (icount,kdlon,kflev
       .                   ,dp,dt0,emis
       .                   ,plev,tlev,tlay,aerosol,coolrate
       .                   ,fluxground,fluxtop
--- 1,4 ----
!        subroutine lwmain (ig0,icount,kdlon,kflev
       .                   ,dp,dt0,emis
       .                   ,plev,tlev,tlay,aerosol,coolrate
       .                   ,fluxground,fluxtop
***************
*** 25,30 ****
--- 25,31 ----
  c               ---------
  c                                                            inputs:
  c                                                            -------
+       integer ig0
        integer icount
        integer kdlon            ! part of ngrid
        integer kflev            ! part of nlayer
***************
*** 48,56 ****
        real fluxtop(ndlo2)             ! outgoing upward flux (W/m2) ("OLR")
        real netrad (ndlo2,kflev)       ! radiative budget (W/m2)
  c     Aerosol optical properties
!       REAL :: QIRsQREF3d(ngridmx,nlayermx,nir,naerkind)
!       REAL :: omegaIR3d(ngridmx,nlayermx,nir,naerkind)
!       REAL :: gIR3d(ngridmx,nlayermx,nir,naerkind)
  
  c----------------------------------------------------------------------
  c         0.2   local arrays
--- 49,57 ----
        real fluxtop(ndlo2)             ! outgoing upward flux (W/m2) ("OLR")
        real netrad (ndlo2,kflev)       ! radiative budget (W/m2)
  c     Aerosol optical properties
!       REAL :: QIRsQREF3d(ndlo2,kflev,nir,naerkind)
!       REAL :: omegaIR3d(ndlo2,kflev,nir,naerkind)
!       REAL :: gIR3d(ndlo2,kflev,nir,naerkind)
  
  c----------------------------------------------------------------------
  c         0.2   local arrays
***************
*** 127,133 ****
                      if( mod(icount-1,ilwd).eq.0) then
  
  c     print*, 'CALL of DISTANTS'
!       call lwxd ( kdlon, kflev, emis
       .          , aer_t, co2_u, co2_up)
  
                      endif
--- 128,134 ----
                      if( mod(icount-1,ilwd).eq.0) then
  
  c     print*, 'CALL of DISTANTS'
!       call lwxd ( ig0, kdlon, kflev, emis
       .          , aer_t, co2_u, co2_up)
  
                      endif
***************
*** 136,142 ****
                      if( mod(icount-1,ilwn).eq.0) then
  
  c     print*, 'CALL of NEIGHBOURS'
!       call lwxn ( kdlon, kflev
       .          , dp
       .          , aer_t, co2_u, co2_up)
  
--- 137,143 ----
                      if( mod(icount-1,ilwn).eq.0) then
  
  c     print*, 'CALL of NEIGHBOURS'
!       call lwxn ( ig0, kdlon, kflev
       .          , dp
       .          , aer_t, co2_u, co2_up)
  
***************
*** 146,152 ****
                      if( mod(icount-1,ilwb).eq.0) then
  
  c     print*, 'CALL of BOUNDARIES'
!       call lwxb ( kdlon, kflev, emis
       .          , aer_t, co2_u, co2_up)
  
                      endif
--- 147,153 ----
                      if( mod(icount-1,ilwb).eq.0) then
  
  c     print*, 'CALL of BOUNDARIES'
!       call lwxb ( ig0, kdlon, kflev, emis
       .          , aer_t, co2_u, co2_up)
  
                      endif
***************
*** 155,161 ****
  c         4.0   cooling rate
  c               ------------
  
!       call lwflux ( kdlon, kflev, dp
       .            , bsurf, btop, blev, blay, dbsublay
       .            , tlay, tlev, dt0      ! pour sortie dans g2d uniquement
       .            , emis
--- 156,162 ----
  c         4.0   cooling rate
  c               ------------
  
!       call lwflux ( ig0, kdlon, kflev, dp
       .            , bsurf, btop, blev, blay, dbsublay
       .            , tlay, tlev, dt0      ! pour sortie dans g2d uniquement
       .            , emis
***************
*** 186,192 ****
  c                ---------------------------
  c
  c
!       call lwi (kdlon,kflev,netrad,dblay,dp
       .          , newcoolrate)
  c
  c  Verif que   (X sol,space) + somme(X i,sol) = 1
--- 187,193 ----
  c                ---------------------------
  c
  c
!       call lwi (ig0,kdlon,kflev,netrad,dblay,dp
       .          , newcoolrate)
  c
  c  Verif que   (X sol,space) + somme(X i,sol) = 1
diff --ignore-blank-lines --context=3 -r oldgcm/lwxb.F oldmeso/lwxb.F
*** oldgcm/lwxb.F	Tue Feb  2 15:41:20 2010
--- oldmeso/lwxb.F	Tue Jan 25 16:49:09 2011
***************
*** 1,4 ****
!       subroutine lwxb (kdlon,kflev
       .                ,emis
       .                ,aer_t,co2_u,co2_up)
  
--- 1,4 ----
!       subroutine lwxb (ig0,kdlon,kflev
       .                ,emis
       .                ,aer_t,co2_u,co2_up)
  
***************
*** 58,64 ****
  c         0.2   local arrays
  c               ------------
  
!       integer ja,jl,jk
  
        real zt_co2 (ndlon,nuco2)
        real zt_aer (ndlon,nuco2)
--- 58,64 ----
  c         0.2   local arrays
  c               ------------
  
!       integer ja,jl,jk,ig0
  
        real zt_co2 (ndlon,nuco2)
        real zt_aer (ndlon,nuco2)
***************
*** 170,181 ****
        ksi_emis(jl,ja,jk) = trans_emis(jl,ja,jk)
       .                   - trans_emis(jl,ja,jk+1) 
  
!       xi(jl,ja,jk,nlaylte+1)= ksi(jl,ja,2,jk) 
       .                        + ksi_emis(jl,ja,jk)* (1 - emis(jl))
  
  c                                                         ksi Reciprocity
  c                                                         ---------------
!       xi(jl,ja,nlaylte+1,jk)      = xi(jl,ja,jk,nlaylte+1)
  
  c-------------------------------------------------------------------------
  c        2.2    echange with ground  (from "layer" 0 toward layers 1,nlaylte)
--- 170,181 ----
        ksi_emis(jl,ja,jk) = trans_emis(jl,ja,jk)
       .                   - trans_emis(jl,ja,jk+1) 
  
!       xi(ig0+jl,ja,jk,nlaylte+1)= ksi(jl,ja,2,jk) 
       .                        + ksi_emis(jl,ja,jk)* (1 - emis(jl))
  
  c                                                         ksi Reciprocity
  c                                                         ---------------
!       xi(ig0+jl,ja,nlaylte+1,jk)      = xi(ig0+jl,ja,jk,nlaylte+1)
  
  c-------------------------------------------------------------------------
  c        2.2    echange with ground  (from "layer" 0 toward layers 1,nlaylte)
***************
*** 185,195 ****
        ksi(jl,ja,1,jk) = trans(jl,ja,1,jk) 
       .                - trans(jl,ja,1,jk+1)
  
!       xi(jl,ja,0,jk) = ksi(jl,ja,1,jk) * emis(jl)
  
  c                                                         ksi Reciprocity
  c                                                         ---------------
!       xi(jl,ja,jk,0) = xi(jl,ja,0,jk)
  
  c-------------------------------------------------------------------------
            enddo
--- 185,195 ----
        ksi(jl,ja,1,jk) = trans(jl,ja,1,jk) 
       .                - trans(jl,ja,1,jk+1)
  
!       xi(ig0+jl,ja,0,jk) = ksi(jl,ja,1,jk) * emis(jl)
  
  c                                                         ksi Reciprocity
  c                                                         ---------------
!       xi(ig0+jl,ja,jk,0) = xi(ig0+jl,ja,0,jk)
  
  c-------------------------------------------------------------------------
            enddo
***************
*** 206,216 ****
          do jl = 1 , kdlon
  
        ksi(jl,ja,1,nlaylte+1) = trans(jl,ja,1,nlaylte+1) 
!       xi(jl,ja,0,nlaylte+1) = ksi(jl,ja,1,nlaylte+1) * emis(jl)
  
  c                                                         ksi Reciprocity
  c                                                         ---------------
!       xi(jl,ja,nlaylte+1,0) = xi(jl,ja,0,nlaylte+1)
  
          enddo
        enddo
--- 206,216 ----
          do jl = 1 , kdlon
  
        ksi(jl,ja,1,nlaylte+1) = trans(jl,ja,1,nlaylte+1) 
!       xi(ig0+jl,ja,0,nlaylte+1) = ksi(jl,ja,1,nlaylte+1) * emis(jl)
  
  c                                                         ksi Reciprocity
  c                                                         ---------------
!       xi(ig0+jl,ja,nlaylte+1,0) = xi(ig0+jl,ja,0,nlaylte+1)
  
          enddo
        enddo
diff --ignore-blank-lines --context=3 -r oldgcm/lwxd.F oldmeso/lwxd.F
*** oldgcm/lwxd.F	Tue Feb  2 15:41:20 2010
--- oldmeso/lwxd.F	Tue Jan 25 16:49:09 2011
***************
*** 1,4 ****
!       subroutine lwxd (kdlon,kflev,emis
       .                ,aer_t,co2_u,co2_up)
  
  c----------------------------------------------------------------------
--- 1,4 ----
!       subroutine lwxd (ig0,kdlon,kflev,emis
       .                ,aer_t,co2_u,co2_up)
  
  c----------------------------------------------------------------------
***************
*** 45,50 ****
--- 45,51 ----
  c               ---------
  c                                                            inputs:
  c                                                            -------
+       integer ig0
        integer kdlon      ! part of ngrid
        integer kflev      ! part of nalyer
   
***************
*** 218,231 ****
  c     print*,'ksi_emis bande',ja,jk,jkk,ksi_emis(jl,ja,jk,jkk)
  c       endif
  
!       xi(jl,ja,jk,jkk) = ksi(jl,ja,jk,jkk)
       .      + ksi_emis(jl,ja,jk,jkk) * (1 - emis(jl))
  
  c                                                        ksi reciprocity
  c                                                        ---------------
        ksi(jl,ja,jkk,jk)      = ksi(jl,ja,jk,jkk)
        ksi_emis(jl,ja,jkk,jk) = ksi_emis(jl,ja,jk,jkk)
!       xi(jl,ja,jkk,jk)   = xi(jl,ja,jk,jkk)
  
              enddo
            enddo
--- 219,232 ----
  c     print*,'ksi_emis bande',ja,jk,jkk,ksi_emis(jl,ja,jk,jkk)
  c       endif
  
!       xi(ig0+jl,ja,jk,jkk) = ksi(jl,ja,jk,jkk)
       .      + ksi_emis(jl,ja,jk,jkk) * (1 - emis(jl))
  
  c                                                        ksi reciprocity
  c                                                        ---------------
        ksi(jl,ja,jkk,jk)      = ksi(jl,ja,jk,jkk)
        ksi_emis(jl,ja,jkk,jk) = ksi_emis(jl,ja,jk,jkk)
!       xi(ig0+jl,ja,jkk,jk)   = xi(ig0+jl,ja,jk,jkk)
  
              enddo
            enddo
***************
*** 244,250 ****
  c    .   trans_emis(jl,ja,jk,jk+1)   - trans_emis(jl,ja,jk+1,jk+1)
  c    . - trans_emis(jl,ja,jk,jk+2) + trans_emis(jl,ja,jk+1,jk+2)
  
!       xi_emis(jl,ja,jk) =
       .                 ksi_emis(jl,ja,jk,jk+1) * (1-emis(jl))
  
            enddo
--- 245,251 ----
  c    .   trans_emis(jl,ja,jk,jk+1)   - trans_emis(jl,ja,jk+1,jk+1)
  c    . - trans_emis(jl,ja,jk,jk+2) + trans_emis(jl,ja,jk+1,jk+2)
  
!       xi_emis(ig0+jl,ja,jk) =
       .                 ksi_emis(jl,ja,jk,jk+1) * (1-emis(jl))
  
            enddo
diff --ignore-blank-lines --context=3 -r oldgcm/lwxn.F oldmeso/lwxn.F
*** oldgcm/lwxn.F	Tue Feb  2 15:41:20 2010
--- oldmeso/lwxn.F	Tue Jan 25 16:49:09 2011
***************
*** 1,4 ****
!       subroutine lwxn ( kdlon,kflev
       .                , dp
       .                , aer_t,co2_u,co2_up)
  
--- 1,4 ----
!       subroutine lwxn ( ig0,kdlon,kflev
       .                , dp
       .                , aer_t,co2_u,co2_up)
  
***************
*** 83,88 ****
--- 83,89 ----
  c               ---------
  c                                                            inputs:
  c                                                            -------
+       integer ig0
        integer kdlon     ! part of ngrid
        integer kflev     ! part of nalyer
  
***************
*** 342,353 ****
  
          do ja = 1 ,nuco2
            do jl = 1 , kdlon
!             xi(jl,ja,jk,jk+1) = ksi(jl,ja,jk)
!      .                            + xi_emis(jl,ja,jk)
  
  c                                                        ksi reciprocity
  c                                                        ---------------
!             xi(jl,ja,jk+1,jk) = xi(jl,ja,jk,jk+1)
            enddo
          enddo
  
--- 343,354 ----
  
          do ja = 1 ,nuco2
            do jl = 1 , kdlon
!             xi(ig0+jl,ja,jk,jk+1) = ksi(jl,ja,jk)
!      .                            + xi_emis(ig0+jl,ja,jk)
  
  c                                                        ksi reciprocity
  c                                                        ---------------
!             xi(ig0+jl,ja,jk+1,jk) = xi(ig0+jl,ja,jk,jk+1)
            enddo
          enddo
  
***************
*** 360,366 ****
  
          do ja = 1 ,nuco2
            do jl = 1 , kdlon
!             xi_ground(jl,ja)=0.
            enddo
          enddo
  
--- 361,367 ----
  
          do ja = 1 ,nuco2
            do jl = 1 , kdlon
!             xi_ground(ig0+jl,ja)=0.
            enddo
          enddo
  
***************
*** 368,374 ****
            do ja = 1 ,nuco2
                do jl = 1 , kdlon
  
!       xi_ground(jl,ja) = xi_ground(jl,ja)
       .                     + ( trans(jl,ja,ni+1,ncouche+1)
       .                        -trans(jl,ja,ni,ncouche+1))
       .                     * 2 * cb(ni)
--- 369,375 ----
            do ja = 1 ,nuco2
                do jl = 1 , kdlon
  
!       xi_ground(ig0+jl,ja) = xi_ground(ig0+jl,ja)
       .                     + ( trans(jl,ja,ni+1,ncouche+1)
       .                        -trans(jl,ja,ni,ncouche+1))
       .                     * 2 * cb(ni)
Only in oldmeso: meso_dimphys.h_ref
Only in oldmeso: meso_dustlift
Only in oldmeso: meso_inifis.F
Only in oldmeso: meso_inifis.F~
Only in oldmeso: meso_newcondens
Only in oldmeso: meso_physiq.F
Only in oldmeso: meso_physiq.F~
Only in oldmeso: meso_testphys1d.F
diff --ignore-blank-lines --context=3 -r oldgcm/newcondens.F oldmeso/newcondens.F
*** oldgcm/newcondens.F	Tue Feb  2 15:41:20 2010
--- oldmeso/newcondens.F	Tue Jan 25 16:49:10 2011
***************
*** 423,429 ****
                 piceco2(ig)=0.
             endif
        ENDDO
!       
  !     Set albedo and emissivity of the surface
  !     ----------------------------------------
        CALL albedocaps(zls,ngrid,piceco2,psolaralb,emisref)
--- 423,429 ----
                 piceco2(ig)=0.
             endif
        ENDDO
! 
  !     Set albedo and emissivity of the surface
  !     ----------------------------------------
        CALL albedocaps(zls,ngrid,piceco2,psolaralb,emisref)
***************
*** 589,618 ****
              do iq=1,nqmx
               zqm(nlayer+1,iq)= zq(nlayer,iq)
              enddo
-   
- c           Tendencies on T, U, V, Q 
- c           """"""""""""""""""""""""
-             DO l=1,nlayer
   
! c             Tendencies on T
!                 zdtsig(ig,l) = (1/masse(l)) *
!      &        ( zmflux(l)*(ztm(l) - ztc(l)) 
!      &        - zmflux(l+1)*(ztm(l+1) - ztc(l))
!      &        + zcondicea(ig,l)*(ztcond(ig,l)-ztc(l))  )
!                 pdtc(ig,l) =  pdtc(ig,l) + zdtsig(ig,l)
! 
! c             Tendencies on U
!                 pduc(ig,l)   = (1/masse(l)) *
!      &        ( zmflux(l)*(zum(l) - zu(l))
!      &        - zmflux(l+1)*(zum(l+1) - zu(l)) )
! 
! 
! c             Tendencies on V
!                 pdvc(ig,l)   = (1/masse(l)) *
!      &        ( zmflux(l)*(zvm(l) - zv(l))
!      &        - zmflux(l+1)*(zvm(l+1) - zv(l)) )
! 
!             END DO
  
  c           Tendencies on Q
              do iq=1,nqmx
--- 589,622 ----
              do iq=1,nqmx
               zqm(nlayer+1,iq)= zq(nlayer,iq)
              enddo
   
! CCCC
! CCCC *** WRF comments
! CCCC
! c 
! cc           Tendencies on T, U, V, Q 
! cc           """"""""""""""""""""""""
! c            DO l=1,nlayer
! c 
! cc             Tendencies on T
! c                zdtsig(ig,l) = (1/masse(l)) *
! c     &        ( zmflux(l)*(ztm(l) - ztc(l)) 
! c     &        - zmflux(l+1)*(ztm(l+1) - ztc(l))
! c     &        + zcondicea(ig,l)*(ztcond(ig,l)-ztc(l))  )
! c                pdtc(ig,l) =  pdtc(ig,l) + zdtsig(ig,l)
! c
! cc             Tendencies on U
! c                pduc(ig,l)   = (1/masse(l)) *
! c     &        ( zmflux(l)*(zum(l) - zu(l))
! c     &        - zmflux(l+1)*(zum(l+1) - zu(l)) )
! c
! c
! cc             Tendencies on V
! c                pdvc(ig,l)   = (1/masse(l)) *
! c     &        ( zmflux(l)*(zvm(l) - zv(l))
! c     &        - zmflux(l+1)*(zvm(l+1) - zv(l)) )
! c
! c            END DO
  
  c           Tendencies on Q
              do iq=1,nqmx
Only in oldgcm: newcondens.F.old
Only in oldmeso: newcondens.F~
Only in oldmeso: nocompile
Only in oldgcm: orodrag.F
Only in oldgcm: orosetup.F
Only in oldmeso: param_slope.F90
Only in oldmeso: param_slope_full.F90
Only in oldgcm: physdem1.F
Only in oldgcm: physiq.F
Only in oldgcm: physiq.F.old
Only in oldgcm: physiq.F~
Only in oldgcm: readtesassim.F90.old
Only in oldmeso: slope.h
Only in oldmeso: splitting
Only in oldmeso: splitting.tar.gz
diff --ignore-blank-lines --context=3 -r oldgcm/suaer.F90 oldmeso/suaer.F90
*** oldgcm/suaer.F90	Tue Feb  2 15:41:20 2010
--- oldmeso/suaer.F90	Tue Jan 25 16:49:09 2011
***************
*** 88,103 ****
  !---- Please indicate the names of the optical property files below
  !     Please also choose the reference wavelengths of each aerosol
  !       naerkind=1, visible range:
! !       file_id(1,1) = 'optprop_dustvis_TM_n50.dat' !M.Wolff
!        file_id(1,1) = 'optprop_dustvis_TM.dat'     !M.Wolff TM
! !       file_id(1,1) = 'optprop_dustvis_MW-MIE.dat' !M.Wolff MIE
  !       file_id(1,1) = 'optprop_dustvis_ockert.dat' !Ockert-Bell
! !        file_id(1,1) = 'optprop_dustvis.dat'        !Clancy-Lee
  !       naerkind=1, infrared:
  !       file_id(1,2) = 'optprop_dustir_TM_n50.dat'  !M.Wolff
!        file_id(1,2) = 'optprop_dustir_TM.dat'      !M.Wolff
  !       file_id(1,2) = 'optprop_dustir_MW-MIE.dat'  !M.Wolff MIE
! !        file_id(1,2) = 'optprop_dustir_x0.5.dat'    !Toon-Forget
  !       naerkind=1, visible range:
          longrefvis(1)=0.67E-6
  !                     For dust: change readtesassim accordingly;
--- 88,103 ----
  !---- Please indicate the names of the optical property files below
  !     Please also choose the reference wavelengths of each aerosol
  !       naerkind=1, visible range:
! !       file_id(1,1) = 'optprop_dustvis_TM_n50.dat' !M.Wolff       !!***WRF: pour faire varier le rayon (experim)
!         file_id(1,1) = 'optprop_dustvis_TM.dat'     !M.Wolff TM    !!***WRF: PAR DEFAUT 
! !       file_id(1,1) = 'optprop_dustvis_MW-MIE.dat' !M.Wolff MIE   !!***WRF: pour test JB
  !       file_id(1,1) = 'optprop_dustvis_ockert.dat' !Ockert-Bell
! !       file_id(1,1) = 'optprop_dustvis.dat'        !Clancy-Lee
  !       naerkind=1, infrared:
  !       file_id(1,2) = 'optprop_dustir_TM_n50.dat'  !M.Wolff
!         file_id(1,2) = 'optprop_dustir_TM.dat'      !M.Wolff
  !       file_id(1,2) = 'optprop_dustir_MW-MIE.dat'  !M.Wolff MIE
! !       file_id(1,2) = 'optprop_dustir_x0.5.dat'    !Toon-Forget
  !       naerkind=1, visible range:
          longrefvis(1)=0.67E-6
  !                     For dust: change readtesassim accordingly;
Only in oldgcm: suaer.F90.old
Only in oldgcm: sugwd.F
diff --ignore-blank-lines --context=3 -r oldgcm/surfdat.h oldmeso/surfdat.h
*** oldgcm/surfdat.h	Tue Feb  2 15:41:20 2010
--- oldmeso/surfdat.h	Tue Jan 25 16:49:10 2011
***************
*** 8,13 ****
--- 8,15 ----
        COMMON/surfdatl/TESicealbedo
  
        real albedodat ! albedo of bare ground
+ ! Ehouarn: moved inertiedat to comsoil.h
+ !      real inertiedat, ! thermal inertia
        real phisfi ! geopotential at ground level
        real albedice ! default albedo for ice (1: North H. 2: South H.)
        real emisice ! ice emissivity; 1:Northern hemisphere 2:Southern hemisphere
Only in oldgcm: surfdat.h.old
Only in oldmeso: surfdat.h~
diff --ignore-blank-lines --context=3 -r oldgcm/swmain.F oldmeso/swmain.F
*** oldgcm/swmain.F	Tue Feb  2 15:41:20 2010
--- oldmeso/swmain.F	Tue Jan 25 16:49:09 2011
***************
*** 72,80 ****
        REAL PFRACT(NDLO2)
        real PFLUXD(NDLON,NFLEV+1,2)
        real PFLUXU(NDLON,NFLEV+1,2)
!       REAL :: QVISsQREF3d(ngridmx,nlayermx,nsun,naerkind)
!       REAL :: omegaVIS3d(ngridmx,nlayermx,nsun,naerkind)
!       REAL :: gVIS3d(ngridmx,nlayermx,nsun,naerkind)
        
  C     LOCAL ARRAYS
  C     ------------
--- 72,80 ----
        REAL PFRACT(NDLO2)
        real PFLUXD(NDLON,NFLEV+1,2)
        real PFLUXU(NDLON,NFLEV+1,2)
!       REAL :: QVISsQREF3d(NDLO2,KFLEV,nsun,naerkind)
!       REAL :: omegaVIS3d(NDLO2,KFLEV,nsun,naerkind)
!       REAL :: gVIS3d(NDLO2,KFLEV,nsun,naerkind)
        
  C     LOCAL ARRAYS
  C     ------------
diff --ignore-blank-lines --context=3 -r oldgcm/swr_toon.F oldmeso/swr_toon.F
*** oldgcm/swr_toon.F	Tue Feb  2 15:41:20 2010
--- oldmeso/swr_toon.F	Tue Jan 25 16:49:10 2011
***************
*** 253,267 ****
  c   FM = flux down
  C  PRIVATES:
        INTEGER J,NL,NLEV
!       PARAMETER (NL=201)
! C  THIS VALUE (201) MUST BE .GE. 2*NAYER
        REAL*8 BSURF,AP,AM,DENOM,EM,EP,G4
!       REAL*8 W0(NL), COSBAR(NL), DTAU(NL), TAU(NL)
!       REAL*8 LAMDA(NL),XK1(NL),XK2(NL)
!       REAL*8 G1(NL),G2(NL),G3(NL)
!       REAL*8 GAMA(NL),CP(NL),CM(NL),CPM1(NL),CMM1(NL)
!       REAL*8 E1(NL),E2(NL),E3(NL),E4(NL)
!         
        NLEV = NAYER+1
        
  C  TURN ON THE DELTA-FUNCTION IF REQUIRED HERE
--- 253,277 ----
  c   FM = flux down
  C  PRIVATES:
        INTEGER J,NL,NLEV
! !!!! AS+JBM 03/2010 BUG BUG si trop niveaux verticaux (LES)
! !!!!                ET PAS BESOIN DE HARDWIRE SALE ICI  !   
! !!!! CORRIGER CE BUG AMELIORE EFFICACITE ET FLEXIBILITE      
!       !! PARAMETER (NL=201) 
!       !! C THIS VALUE (201) MUST BE .GE. 2*NAYER
        REAL*8 BSURF,AP,AM,DENOM,EM,EP,G4
!       !! REAL*8 W0(NL), COSBAR(NL), DTAU(NL), TAU(NL)
!       !! REAL*8 LAMDA(NL),XK1(NL),XK2(NL)
!       !! REAL*8 G1(NL),G2(NL),G3(NL)
!       !! REAL*8 GAMA(NL),CP(NL),CM(NL),CPM1(NL),CMM1(NL)
!       !! REAL*8 E1(NL),E2(NL),E3(NL),E4(NL)
!       REAL*8 W0(2*NAYER), COSBAR(2*NAYER), DTAU(2*NAYER), TAU(2*NAYER)  
!       REAL*8 LAMDA(2*NAYER),XK1(2*NAYER),XK2(2*NAYER)
!       REAL*8 G1(2*NAYER),G2(2*NAYER),G3(2*NAYER)
!       REAL*8 GAMA(2*NAYER),CP(2*NAYER),CM(2*NAYER),CPM1(2*NAYER)
!       REAL*8 CMM1(2*NAYER)
!       REAL*8 E1(2*NAYER),E2(2*NAYER),E3(2*NAYER),E4(2*NAYER)
! 
!       NL = 2*NAYER  !!! AS+JBM 03/2010 
        NLEV = NAYER+1
        
  C  TURN ON THE DELTA-FUNCTION IF REQUIRED HERE
***************
*** 381,391 ****
  
  C DOUBLE PRECISION VERSION OF SOLVER
  
!       PARAMETER (NMAX=201)
        IMPLICIT REAL*8  (A-H,O-Z)
        DIMENSION GAMA(NL),CP(NL),CM(NL),CPM1(NL),CMM1(NL),XK1(NL),
       *          XK2(NL),E1(NL),E2(NL),E3(NL),E4(NL)
!       DIMENSION AF(NMAX),BF(NMAX),CF(NMAX),DF(NMAX),XK(NMAX)
  C*********************************************************
  C* THIS SUBROUTINE SOLVES FOR THE COEFFICIENTS OF THE    *
  C* TWO STREAM SOLUTION FOR GENERAL BOUNDARY CONDITIONS   *
--- 391,405 ----
  
  C DOUBLE PRECISION VERSION OF SOLVER
  
! cc      PARAMETER (NMAX=201)
! cc AS+JBM 03/2010
        IMPLICIT REAL*8  (A-H,O-Z)
        DIMENSION GAMA(NL),CP(NL),CM(NL),CPM1(NL),CMM1(NL),XK1(NL),
       *          XK2(NL),E1(NL),E2(NL),E3(NL),E4(NL)
! cc AS+JBM 03/2010      
! cc      DIMENSION AF(NMAX),BF(NMAX),CF(NMAX),DF(NMAX),XK(NMAX)
!       DIMENSION AF(2*NL),BF(2*NL),CF(2*NL),DF(2*NL),XK(2*NL)
! 
  C*********************************************************
  C* THIS SUBROUTINE SOLVES FOR THE COEFFICIENTS OF THE    *
  C* TWO STREAM SOLUTION FOR GENERAL BOUNDARY CONDITIONS   *
***************
*** 481,490 ****
  
  C     DOUBLE PRECISION VERSION OF TRIDGL
  
!       PARAMETER (NMAX=201)
        IMPLICIT REAL*8  (A-H,O-Z)
        DIMENSION AF(L),BF(L),CF(L),DF(L),XK(L)
!       DIMENSION AS(NMAX),DS(NMAX)
  
  C*    THIS SUBROUTINE SOLVES A SYSTEM OF TRIDIAGIONAL MATRIX
  C*    EQUATIONS. THE FORM OF THE EQUATIONS ARE:
--- 495,507 ----
  
  C     DOUBLE PRECISION VERSION OF TRIDGL
  
! cc AS+JBM 03/2010 : OBSOLETE MAINTENANT      
! cc      PARAMETER (NMAX=201)
        IMPLICIT REAL*8  (A-H,O-Z)
        DIMENSION AF(L),BF(L),CF(L),DF(L),XK(L)
! cc AS+JBM 03/2010 : OBSOLETE MAINTENANT
! cc      DIMENSION AS(NMAX),DS(NMAX)
!       DIMENSION AS(L),DS(L)
  
  C*    THIS SUBROUTINE SOLVES A SYSTEM OF TRIDIAGIONAL MATRIX
  C*    EQUATIONS. THE FORM OF THE EQUATIONS ARE:
Only in oldgcm: testphys1d.F
Only in oldmeso: ye
Only in oldmeso: yeye
