*=*=*=*= radia1d.html =*=*=*=*
PROGRAM radia1d

PROGRAM radia1d


      PROGRAM radia1d
      IMPLICIT NONE
#include "dimensions.h"
#include "dimphys.h"
#include "comgeomfi.h"
#include "surfdat.h"
#include "comdiurn.h"
#include "callkeys.h"
#include "comcstfi.h"
#include "planete.h"
#include "comsaison.h"

c    Arguments :
c    -----------

      INTEGER ngrid,nlayer,nq

      REAL plev(nlayermx+1),play(nlayermx)
      REAL temp(nlayermx)
      REAL psrf

c   dynamial tendencies

      INTEGER l,ierr,aslun,nlevel,iaer
c
      REAL day_ini,time,longitude,latitude
      REAL zlay(nlayermx)
      REAL ztlev(nlayermx+1)
      REAL zplanck
      REAL zrad(nlayermx),zradc(nlayermx)
      REAL zdum1(nlayermx)
      REAL zdum2(nlayermx)
      REAL zdum3(nlayermx)
      REAL zdum4(nlayermx)
      REAL zdum5(nlayermx)
      REAL stephan
      REAL ztim1,ztim2,ztim3
      REAL zco2,zp
      REAL ls,zmax,tau,tau_tot
      REAL dtlw(nlayermx),dtsw(nlayermx)
      REAL dtlwcl(nlayermx),dtswcl(nlayermx)
      REAL zflux(6)

      REAL aerosol(nlayermx,5),cst_aer,pview
      REAL tsurf,tsoil(nsoilmx)
      REAL co2ice,albedo(2),emis
      REAL dtrad(nlayermx),fluxrad

      DATA stephan/5.67e-08/
      DATA psrf,zmax/775.,9./
      DATA ls,time,latitude,longitude/0.,12.,0.,0./
      DATA diurnal/.true./
      DATA tau/.5/

c   WARNING declin and dist_sol are prescribed instead of Ls
      DATA declin,dist_sol/-24.8,1.4/

c-----------------------------------------------------------------------
c    1. Initialisations :
c    --------------------

      PRINT*,'tau?'
      READ(5,*) tau
      PRINT*,'time 0 to 24 h'
      READ(5,*) time
      PRINT*,'latitude (degrees)'
      READ(5,*) latitude

      pi=2.*asin(1.)
      ls=ls*pi/180.
      time=time/24.
      latitude=latitude*pi/180.
      longitude=longitude*pi/180.
      declin=declin*pi/180.

      ngrid=1
      nlayer=nlayermx
      nlevel=nlayer+1

      rad=3397200.
      omeg=4.*asin(1.)/(88775.)
      g=3.72
      mugaz=43.49
      rcp=.256793
      unjours=88775.
      daysec=unjours
      r       = 8.314511*1000./mugaz
      cpp     = r/rcp
      PRINT*,'Cp  =  ',cpp
      PRINT*,'R   =  ',r

      CALL readparam

      tsurf=200.
      DO l=1,nlayer
         zlay(l)=zmax*(l-.5)/nlayer
         plev(l)=psrf*exp(-zmax*(l-1.)/nlayer)
         play(l)=psrf*exp(-zlay(l))
      ENDDO
      plev(nlevel)=0.

      DO l=1,nlayer
         temp(l)=200.
      ENDDO

      DO l=1,nlayer
         dtrad(l)=0.
      ENDDO
      fluxrad=0.

      albedo(1)=.24
      albedo(2)=.24
      emis=1.
      CALL iniorbit(aphelie,periheli,year_day,peri_day,obliquit)

c  a total otempical detemph of .2 for Ps=700Pa
      cst_aer=tau/700.
      pview=1.66
      CALL sucst(66,19900101,8000000,g,rad,mugaz,rcp,unjours)
      CALL surad(6)

      IF (ngrid.NE.ngridmx) THEN
         PRINT*,'STOP in inifis'
         PRINT*,'Probleme de dimenesions :'
         PRINT*,'ngrid     = ',ngrid
         PRINT*,'ngridmx   = ',ngridmx
         STOP
      ENDIF

c-----------------------------------------------------------------------
c    2. Calcul of the radiative tendencies :
c    ---------------------------------------


c     CALL orbite(ls,dist_sol,declin)
      IF(diurnal) THEN
         ztim1=SIN(declin)
         ztim2=COS(declin)*COS(2.*pi*(time-.5))
         ztim3=-COS(declin)*SIN(2.*pi*(time-.5))
         CALL solang(ngrid,sin(longitude),cos(longitude),
     s   sin(latitude),cos(latitude),
     s   ztim1,ztim2,ztim3,
     s   mu0,fract)
         PRINT*,'time, declin, sinlon,coslon,sinlat,coslat'
         PRINT*,time, declin,sin(longitude),cos(longitude),
     s   sin(latitude),cos(latitude)
      ELSE
         CALL mucorr(ngrid,declin, lati, mu0, fract,10000.,rad)
      ENDIF

c    2.2 Calcul of the radiative tendencies and fluxes:
c    --------------------------------------------------

c   2.1.1 layers
      tau_tot=0.
      DO l=1,nlayer
         zp=plev(1)/play(l)
         aerosol(l,1)=amax1(cst_aer*
     s            (plev(l)-plev(l+1))
     s            *exp(.03*(1.-zp)),1.e-33)
         aerosol(l,1)=amax1(
     s   tau*(plev(l)-plev(l+1))/plev(1)
     s   *exp(.007*(1.-zp)),1.e-33)
         tau_tot=tau_tot+aerosol(l,1)
      ENDDO
      PRINT*,'tau total',tau_tot
      DO l=1,nlayermx
         aerosol(l,1)=aerosol(l,1)*tau/tau_tot
      ENDDO

c  2.1.2 levels

c  Extrapolation for the air temperature above the surface
      ztlev(1)=temp(1)+
     s     (plev(1)-play(1))*
     s     (temp(1)-temp(2))/(play(1)-play(2))

      DO l=2,nlevel-1
         ztlev(l)=0.5*(temp(l-1)+temp(l))
      ENDDO

      ztlev(nlevel)=temp(nlayer)
      PRINT*,'temp'

      DO l=1,nlayer
         zdum1(l)=0.
         zdum2(l)=0.
         zdum3(l)=0.
         zdum4(l)=0.
         zdum5(l)=0.
         DO iaer=2,5
            aerosol(l,iaer)=0.
         ENDDO
      ENDDO

c    2.3 Calcul of the radiative tendencies and fluxes:
c    --------------------------------------------------

      zco2=.95
      CALL radite(ngrid,nlayer,0,6,1,1,
     $         aerosol,albedo,zco2,zdum4,emis,
     $         mu0,zdum5,
     $         plev,play,zdum1,zdum2,zdum3,ztlev,tsurf,temp,pview,
     $         dtlw,dtsw,dtlwcl,dtswcl,zflux,zrad,zradc,
     $         fract,dist_sol)
      PRINT*,'radite'

c    2.4 total flux and tendencies:
c    ------------------------------

c    2.4.1 fluxes

      fluxrad=emis*zflux(4)
     $   +zflux(5)*(1.-albedo(1))
     $   +zflux(6)*(1.-albedo(2))
      zplanck=tsurf*tsurf
      zplanck=emis*
     $   stephan*zplanck*zplanck
      fluxrad=fluxrad-zplanck

c    2.4.2 temperature tendencies

      DO l=1,nlayer
         dtrad(l)=(dtsw(l)+dtlw(l))/unjours
         dtsw(l)=cpp*dtsw(l)/unjours
         dtlw(l)=dtlw(l)
      ENDDO


c    2.5 Transformation of the radiative tendencies:
c    -----------------------------------------------

      PRINT*,'Diagnotique for the radaition'
      PRINT*,'albedo, emissiv, mu0,fract,pview,Frad,Planck'
      PRINT*,albedo(1),emis,mu0,fract,pview,fluxrad,zplanck
      PRINT*,'insolation',fract*mu0*1370.,'    Fsol=',
     s   zflux(5)+zflux(6)
      PRINT*,'Tlay Tlev Play Plev z aerosol dT/dt SW dT/dt LW (K/day)'
      PRINT*,'unjours',unjours
      DO l=1,nlayer
         WRITE(*,'(2f7.1,2e11.3,f6.1,3e14.5)')
     s   temp(l),ztlev(l),play(l),plev(l),zlay(l),
     s   g*aerosol(l,1)/(plev(l)-plev(l+1)),dtsw(l),dtlw(l)
         WRITE(55,'(2e15.5)') -dtlw(l),.001*zlay(l)*r*200./g
         WRITE(56,'(2e15.5)') dtsw(l),zlay(l)
      ENDDO

      END