! $Id$ ! MODULE infotrac ! nqtot : total number of tracers and higher order of moment, water vapor and liquid included INTEGER, SAVE :: nqtot ! nbtr : number of tracers not including higher order of moment or water vapor or liquid ! number of tracers used in the physics INTEGER, SAVE :: nbtr ! Name variables CHARACTER(len=20), ALLOCATABLE, DIMENSION(:), SAVE :: tname ! tracer short name for restart and diagnostics CHARACTER(len=23), ALLOCATABLE, DIMENSION(:), SAVE :: ttext ! tracer long name for diagnostics ! iadv : index of trasport schema for each tracer INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: iadv ! niadv : vector keeping the coorspondance between all tracers(nqtot) treated in the ! dynamic part of the code and the tracers (nbtr+2) used in the physics part of the code. INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: niadv ! equivalent dyn / physique ! conv_flg(it)=0 : convection desactivated for tracer number it INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: conv_flg ! pbl_flg(it)=0 : boundary layer diffusion desactivaded for tracer number it INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: pbl_flg CHARACTER(len=4),SAVE :: type_trac CONTAINS SUBROUTINE infotrac_init IMPLICIT NONE !======================================================================= ! ! Auteur: P. Le Van /L. Fairhead/F.Hourdin ! ------- ! Modif special traceur F.Forget 05/94 ! Modif M-A Filiberti 02/02 lecture de traceur.def ! ! Objet: ! ------ ! GCM LMD nouvelle grille ! !======================================================================= ! ... modification de l'integration de q ( 26/04/94 ) .... !----------------------------------------------------------------------- ! Declarations INCLUDE "dimensions.h" INCLUDE "control.h" INCLUDE "iniprint.h" ! Local variables INTEGER, ALLOCATABLE, DIMENSION(:) :: hadv ! index of horizontal trasport schema INTEGER, ALLOCATABLE, DIMENSION(:) :: vadv ! index of vertical trasport schema CHARACTER(len=15), ALLOCATABLE, DIMENSION(:) :: tnom_0 ! tracer short name CHARACTER(len=8), ALLOCATABLE, DIMENSION(:) :: tracnam ! name from INCA CHARACTER(len=3), DIMENSION(30) :: descrq CHARACTER(len=1), DIMENSION(3) :: txts CHARACTER(len=2), DIMENSION(9) :: txtp CHARACTER(len=13) :: str1,str2 INTEGER :: nqtrue ! number of tracers read from tracer.def, without higer order of moment INTEGER :: iq, new_iq, iiq, jq, ierr INTEGER, EXTERNAL :: lnblnk !----------------------------------------------------------------------- ! Initialization : ! txts=(/'x','y','z'/) txtp=(/'x ','y ','z ','xx','xy','xz','yy','yz','zz'/) descrq(14)='VLH' descrq(10)='VL1' descrq(11)='VLP' descrq(12)='FH1' descrq(13)='FH2' descrq(16)='PPM' descrq(17)='PPS' descrq(18)='PPP' descrq(20)='SLP' descrq(30)='PRA' IF (config_inca=='none') THEN type_trac='lmdz' ELSE type_trac='inca' END IF !----------------------------------------------------------------------- ! ! 1) Get the true number of tracers + water vapor/liquid ! Here true tracers (nqtrue) means declared tracers (only first order) ! !----------------------------------------------------------------------- IF (type_trac == 'lmdz') THEN OPEN(90,file='traceur.def',form='formatted',status='old', iostat=ierr) IF(ierr.EQ.0) THEN WRITE(lunout,*) 'Open traceur.def : ok' READ(90,*) nqtrue ELSE WRITE(lunout,*) 'Problem in opening traceur.def' WRITE(lunout,*) 'ATTENTION using defaut values' nqtrue=4 ! Defaut value END IF ! Attention! Only for planet_type=='earth' nbtr=nqtrue-2 ELSE ! nbtr has been read from INCA by init_cont_lmdz() in gcm.F nqtrue=nbtr+2 END IF IF (nqtrue < 2) THEN WRITE(lunout,*) 'nqtrue=',nqtrue, ' is not allowded. 2 tracers is the minimum' CALL abort_gcm('infotrac_init','Not enough tracers',1) END IF ! ! Allocate variables depending on nqtrue and nbtr ! ALLOCATE(tnom_0(nqtrue), hadv(nqtrue), vadv(nqtrue)) ALLOCATE(conv_flg(nbtr), pbl_flg(nbtr), tracnam(nbtr)) conv_flg(:) = 1 ! convection activated for all tracers pbl_flg(:) = 1 ! boundary layer activated for all tracers !----------------------------------------------------------------------- ! 2) Choix des schemas d'advection pour l'eau et les traceurs ! ! iadv = 1 schema transport type "humidite specifique LMD" ! iadv = 2 schema amont ! iadv = 14 schema Van-leer + humidite specifique ! Modif F.Codron ! iadv = 10 schema Van-leer (retenu pour l'eau vapeur et liquide) ! iadv = 11 schema Van-Leer pour hadv et version PPM (Monotone) pour vadv ! iadv = 12 schema Frederic Hourdin I ! iadv = 13 schema Frederic Hourdin II ! iadv = 16 schema PPM Monotone(Collela & Woodward 1984) ! iadv = 17 schema PPM Semi Monotone (overshoots autorisés) ! iadv = 18 schema PPM Positif Defini (overshoots undershoots autorisés) ! iadv = 20 schema Slopes ! iadv = 30 schema Prather ! ! Dans le tableau q(ij,l,iq) : iq = 1 pour l'eau vapeur ! iq = 2 pour l'eau liquide ! Et eventuellement iq = 3,nqtot pour les autres traceurs ! ! iadv(1): choix pour l'eau vap. et iadv(2) : choix pour l'eau liq. !------------------------------------------------------------------------ ! ! Get choice of advection schema from file tracer.def or from INCA !--------------------------------------------------------------------- IF (type_trac == 'lmdz') THEN IF(ierr.EQ.0) THEN ! Continue to read tracer.def DO iq=1,nqtrue READ(90,999) hadv(iq),vadv(iq),tnom_0(iq) END DO CLOSE(90) ELSE ! Without tracer.def hadv(1) = 14 vadv(1) = 14 tnom_0(1) = 'H2Ov' hadv(2) = 10 vadv(2) = 10 tnom_0(2) = 'H2Ol' hadv(3) = 10 vadv(3) = 10 tnom_0(3) = 'RN' hadv(4) = 10 vadv(4) = 10 tnom_0(4) = 'PB' END IF WRITE(lunout,*) 'Valeur de traceur.def :' WRITE(lunout,*) 'nombre de traceurs ',nqtrue DO iq=1,nqtrue WRITE(lunout,*) hadv(iq),vadv(iq),tnom_0(iq) END DO ELSE ! type_trac=inca : config_inca='aero' ou 'chem' ! le module de chimie fournit les noms des traceurs ! et les schemas d'advection associes. #ifdef INCA CALL init_transport( & hadv, & vadv, & conv_flg, & pbl_flg, & tracnam) #endif tnom_0(1)='H2Ov' tnom_0(2)='H2Ol' DO iq =3,nqtrue tnom_0(iq)=tracnam(iq-2) END DO END IF ! type_trac !----------------------------------------------------------------------- ! ! 3) Verify if advection schema 20 or 30 choosen ! Calculate total number of tracers needed: nqtot ! Allocate variables depending on total number of tracers !----------------------------------------------------------------------- new_iq=0 DO iq=1,nqtrue ! Add tracers for certain advection schema IF (hadv(iq)<20 .AND. vadv(iq)<20 ) THEN new_iq=new_iq+1 ! no tracers added ELSE IF (hadv(iq)==20 .AND. vadv(iq)==20 ) THEN new_iq=new_iq+4 ! 3 tracers added ELSE IF (hadv(iq)==30 .AND. vadv(iq)==30 ) THEN new_iq=new_iq+10 ! 9 tracers added ELSE WRITE(lunout,*) 'This choice of advection schema is not available' CALL abort_gcm('infotrac_init','Bad choice of advection schema - 1',1) END IF END DO IF (new_iq /= nqtrue) THEN ! The choice of advection schema imposes more tracers ! Assigne total number of tracers nqtot = new_iq WRITE(lunout,*) 'The choice of advection schema for one or more tracers' WRITE(lunout,*) 'makes it necessary to add tracers' WRITE(lunout,*) nqtrue,' is the number of true tracers' WRITE(lunout,*) nqtot, ' is the total number of tracers needed' ELSE ! The true number of tracers is also the total number nqtot = nqtrue END IF ! ! Allocate variables with total number of tracers, nqtot ! ALLOCATE(tname(nqtot), ttext(nqtot)) ALLOCATE(iadv(nqtot), niadv(nqtot)) !----------------------------------------------------------------------- ! ! 4) Determine iadv, long and short name ! !----------------------------------------------------------------------- new_iq=0 DO iq=1,nqtrue new_iq=new_iq+1 ! Verify choice of advection schema IF (hadv(iq)==vadv(iq)) THEN iadv(new_iq)=hadv(iq) ELSE IF (hadv(iq)==10 .AND. vadv(iq)==16) THEN iadv(new_iq)=11 ELSE WRITE(lunout,*)'This choice of advection schema is not available' CALL abort_gcm('infotrac_init','Bad choice of advection schema - 2',1) END IF str1=tnom_0(iq) tname(new_iq)= tnom_0(iq) IF (iadv(new_iq)==0) THEN ttext(new_iq)=str1(1:lnblnk(str1)) ELSE ttext(new_iq)=str1(1:lnblnk(str1))//descrq(iadv(new_iq)) END IF ! schemas tenant compte des moments d'ordre superieur str2=ttext(new_iq) IF (iadv(new_iq)==20) THEN DO jq=1,3 new_iq=new_iq+1 iadv(new_iq)=-20 ttext(new_iq)=str2(1:lnblnk(str2))//txts(jq) tname(new_iq)=str1(1:lnblnk(str1))//txts(jq) END DO ELSE IF (iadv(new_iq)==30) THEN DO jq=1,9 new_iq=new_iq+1 iadv(new_iq)=-30 ttext(new_iq)=str2(1:lnblnk(str2))//txtp(jq) tname(new_iq)=str1(1:lnblnk(str1))//txtp(jq) END DO END IF END DO ! ! Find vector keeping the correspodence between true and total tracers ! niadv(:)=0 iiq=0 DO iq=1,nqtot IF(iadv(iq).GE.0) THEN ! True tracer iiq=iiq+1 niadv(iiq)=iq ENDIF END DO WRITE(lunout,*) 'Information stored in infotrac :' WRITE(lunout,*) 'iadv niadv tname ttext :' DO iq=1,nqtot WRITE(lunout,*) iadv(iq),niadv(iq), tname(iq), ttext(iq) END DO ! ! Test for advection schema. ! This version of LMDZ only garantees iadv=10 and iadv=14 (14 only for water vapour) . ! DO iq=1,nqtot IF (iadv(iq)/=10 .AND. iadv(iq)/=14 .AND. iadv(iq)/=0) THEN WRITE(lunout,*)'STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ' CALL abort_gcm('infotrac_init','In this version only iadv=10 and iadv=14 is tested!',1) ELSE IF (iadv(iq)==14 .AND. iq/=1) THEN WRITE(lunout,*)'STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ' CALL abort_gcm('infotrac_init','In this version iadv=14 is only permitted for water vapour!',1) END IF END DO !----------------------------------------------------------------------- ! Finalize : ! DEALLOCATE(tnom_0, hadv, vadv) DEALLOCATE(tracnam) 999 FORMAT (i2,1x,i2,1x,a15) END SUBROUTINE infotrac_init END MODULE infotrac