su_aerw.F90

Go to the documentation of this file.

SUBROUTINE su_aerw

!**** *SU_AERW*   - DEFINES INDICES AND PARAMETERS FOR VARIOUS AEROSOL VARIABLES

!     PURPOSE.
!     --------
!           INITIALIZE YOEAERATM, YOEAERSRC, YOEAERSNK, THE MODULES THAT CONTAINS INDICES
!           ALLOWING TO GET THE AEROSOL PARAMETERS RELEVANT FOR THE PROGNOSTIC AEROSOL
!           CONFIGURATION.

!**   INTERFACE.
!     ----------
!        *CALL* *SU_AERW

!        EXPLICIT ARGUMENTS :
!        --------------------
!        NONE

!        IMPLICIT ARGUMENTS :
!        --------------------
!        YOEAERW

!     METHOD.
!     -------
!        SEE DOCUMENTATION

!     EXTERNALS.
!     ----------

!     REFERENCE.
!     ----------
!        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS

!     AUTHOR.
!     -------
!        JEAN-JACQUES MORCRETTE *ECMWF*

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 2005-07-08

!     ------------------------------------------------------------------

USE parkind1  ,ONLY : jpim     ,jprb
USE yomhook   ,ONLY : lhook,   dr_hook

USE yoeaeratm, ONLY : laergbud, laerscav ,laersedim, laersurf, laer6sdia, &
 & laerclimg, laerclimz, laerclist, laerdrydp, laerngat, laerprnt, &
 & repscaer , indbg

USE yoeaersrc, ONLY : jkbin, jktyp, lepaero  , &
 & nbinaer, nindaer , nmaxtaer, ntaer  , ntypaer, rgelav , rgemuv , &
 & rdglav , rdgmuv  , rclonv  , rslonv , rdclonv, rdslonv, laerextr, &
 & rssflx , rlatvol , rlonvol , nddust

USE yoephy   , ONLY : le4alb

USE yoedbug  , ONLY : kstpdbg

USE yomcst   , ONLY : rpi
USE yomgc    , ONLY : gelam
USE yomgem   , ONLY : ngptot
USE yomleg   , ONLY : rmu
! Ce qui concerne NULNAM commente par MPL le 15.04.09
!USE YOMLUN   , ONLY : NULNAM, NULOUT
USE yomlun   , ONLY : nulout

USE yom_ygfl, ONLY : naero

IMPLICIT NONE

INTEGER(KIND=JPIM) :: IAER, ICAER, ITAER
INTEGER(KIND=JPIM) :: J, JAER, JL

REAL(KIND=JPRB) :: ZHOOK_HANDLE
!     ----------------------------------------------------------------

#include "posnam.intfb.h"

#include "su_aerp.intfb.h"
#include "su_aerop.intfb.h"
!      ----------------------------------------------------------------

#include "naeaer.h"

!      ----------------------------------------------------------------
IF (lhook) CALL dr_hook('SU_AERW',0,zhook_handle)

!*         1.       DEFAULT VALUES OF PARAMETERS
!                   ----------------------------

print *,'DANS SU_AERW'
nbinaer(:) = (/ 3, 3, 2, 2, 1, 1, 1, 1, 1 /)

nmaxtaer=9
ntypaer(:) = 0
jkbin(:) = 0
jktyp(:) = 0

lepaero=.false.
laerclimg=.false.
laerclimz=.false.
laerclist=.false.
laerdrydp=.false.
laerextr=.false.
laergbud=.false.
laerngat=.false.
laerprnt=.false.
laerscav=.false.
laersedim=.false.
laersurf=.false.
laer6sdia=.false.
indbg=1
ntaer  =0
nddust =2

! the 9 types and assumed number of bins are:
!  NTYPAER    bins  type
!     1       1- 3  sea-salt  0.03 - 0.5 -  5  - 20 microns
!     2       4- 6  dust      0.03 - 0.5 - 0.9 - 20 microns
!     3       7- 8  POM             hydrophilic, hydrophobic
!     4       9-10  BC              hydrophilic, hydrophobic
!     5      11     sulfate
!     6      12     fly ash
!     7      13     pseudo-prognostic stratospheric aerosols
!     8      14     pseudo-prognostic volcanic aerosols
!     9      15     prognostic stratospheric aerosols
 
DO jaer=1,nmaxtaer
  ntypaer(jaer)=0
ENDDO

rlatvol=-999._jprb
rlonvol=-999._jprb
rgelav =-999._jprb
rgemuv =-999._jprb
rdglav = 999._jprb
rdgmuv = 999._jprb
rclonv =-999._jprb
rslonv =-999._jprb
rdclonv= 999._jprb
rdslonv= 999._jprb
DO j=1,3
  kstpdbg(j)=-999
ENDDO

repscaer=1.e-15_jprb

!     ------------------------------------------------------------------

!*         2.       READ VALUES OF PROGNOSTIC AEROSOL CONFIGURATION
!                   -----------------------------------------------
! Ce qui concerne NAEAER commente par MPL le 15.04.09
!IF(NAERO > 0) THEN
! CALL POSNAM(NULNAM,'NAEAER')
! READ (NULNAM,NAEAER)
!ENDIF

IF (.NOT.le4alb) THEN
  nddust=2
ENDIF
!     ------------------------------------------------------------------

!*       3.    INITIALIZE PROGNOSTIC AEROSOL PHYSICAL AND OPTICAL PARAMETERS
!              -------------------------------------------------------------

  CALL su_aerp
print *,'SU_AERW: apres SU_AERP'
  CALL su_aerop
print *,'SU_AERW: apres SU_AEROP'

IF (lepaero) THEN

! define a composite index for each bin of each different aerosol type to be used
! in source, sedimentation and deposition routines
 
  icaer=0
  DO jaer=1,nmaxtaer
    IF (ntypaer(jaer) /= 0) THEN
      ntaer=ntaer+1
      itaer=ntypaer(jaer)
      DO iaer=1,itaer
        icaer=icaer+1
        nindaer(icaer)=jaer*10+iaer
        jktyp(icaer)=jaer
        jkbin(icaer)=iaer
      ENDDO
    ENDIF
  ENDDO

!-- if volcanic aerosols, define the model coordinates

  IF (ntypaer(9) /= 0) THEN
    rgemuv=(rlatvol+90._jprb)*rpi/180._jprb
    rgelav=rlonvol*rpi/180._jprb
    rclonv=cos(rgelav)
    rslonv=sin(rgelav)
    DO j=1,ngptot-1
      IF (rgelav > gelam(j) .AND. rgelav <= gelam(j+1) .AND. &
        & rgemuv < rmu(jl) .AND. rgemuv >= rmu(jl+1) ) THEN
        rdgmuv=abs( rmu(j+1) - rmu(j))
        rdglav=abs( gelam(j+1)-gelam(j) )
        rdslonv=abs( sin(gelam(jl+1))-sin(gelam(jl)) )
        rdclonv=abs( cos(gelam(jl+1))-cos(gelam(jl)) )
      ENDIF
    ENDDO
  ENDIF  

!      ----------------------------------------------------------------

!*       4.    PRINT FINAL VALUES.
!              -------------------

  WRITE(unit=nulout,fmt='('' LEPAERO = '',L5 &
   & ,'' NTAER   = '',I2 ,'' NDDUST = '',I1,/&
   & ,'' NTYPAER = '',9I3,/ &
   & ,'' NBINAER = '',9I3,/ &
   & ,'' JKTYP   = '',15I3,/&
   & ,'' JKBIN   = '',15I3  &
   & )')&
   & lepaero,ntaer,(ntypaer(jaer),jaer=1,9),(nbinaer(jaer),jaer=1,9), &
   & (jktyp(jaer),jaer=1,15),(jkbin(jaer),jaer=1,15)
  WRITE(unit=nulout,fmt='('' LAERGBUD = '',L3 &
   & ,'' LAERNGAT = '',L3 &
   & ,'' LAERDRYDP= '',L3 &
   & ,'' LAERSEDIM= '',L3 &
   & ,'' LAERSCAV = '',L3 &
   & ,'' LAER6SDIA= '',L3 &
   & ,'' LAERCLIMZ= '',L3 &
   & ,'' LAERCLIMG= '',L3 &
   & ,'' LAERCLIST= '',L3 &
   & )')&
   & laergbud,laerngat, laerdrydp,laersedim,laerscav,laer6sdia,laerclimz,laerclimg,laerclist
  WRITE(unit=nulout,fmt='('' RSSFLX= '',10E10.3)') rssflx
  IF (ntypaer(9) /= 0) THEN
    WRITE(unit=nulout,fmt='('' RLATVOL= '',F5.2 &
     & ,'' RLONVOL= '',F6.2,'' RGEMUV= '',F6.4,'' RGELAV= '',F6.4 &
     & ,'' RCLONV = '',F6.4,'' RSLONV= '',F6.4,'' RDGMUV= '',F6.4 &
     & ,'' RDGLAV = '',F6.4,'' RDCLONV= '',F6.4,'' RDSLONV= '',F6.4 &
     & )')&
     & rlatvol,rlonvol,rgemuv,rgelav,rclonv,rslonv,rdgmuv,rdglav,rdclonv,rdslonv
  ENDIF
ENDIF

!     ----------------------------------------------------------------
IF (lhook) CALL dr_hook('SU_AERW',1,zhook_handle)
END SUBROUTINE su_aerw