! ! $Header$ ! c c subroutine iniadvtrac(nq) USE ioipsl IMPLICIT NONE c======================================================================= c c Auteur: P. Le Van /L. Fairhead/F.Hourdin c ------- c Modif special traceur F.Forget 05/94 c Modif M-A Filiberti 02/02 lecture de traceur.def c c Objet: c ------ c c GCM LMD nouvelle grille c c======================================================================= c ... modification de l'integration de q ( 26/04/94 ) .... c----------------------------------------------------------------------- c Declarations: c ------------- C #include "dimensions.h" #include "advtrac.h" #include "control.h" c local character*3 descrq(30) character*1 txts(3) character*2 txtp(9) character*13 str1,str2,str3 integer nq,iq,iiq,iiiq,ierr,ii integer lnblnk external lnblnk data txts/'x','y','z'/ data txtp/'x','y','z','xx','xy','xz','yy','yz','zz'/ c----------------------------------------------------------------------- c Initialisations: c ---------------- 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 #ifdef INCA CALL init_transport( $ hadv_flg, $ vadv_flg, $ conv_flg, $ pbl_flg, $ tracnam) #endif END IF c----------------------------------------------------------------------- c Choix des schemas d'advection pour l'eau et les traceurs c c iadv = 1 schema transport type "humidite specifique LMD" c iadv = 2 schema amont c iadv = 14 schema Van-leer + humidite specifique c Modif F.Codron c iadv = 10 schema Van-leer (retenu pour l'eau vapeur et liquide) c iadv = 11 schema Van-Leer pour hadv et version PPM (Monotone) pour vadv c iadv = 12 schema Frederic Hourdin I c iadv = 13 schema Frederic Hourdin II c iadv = 16 schema PPM Monotone(Collela & Woodward 1984) c iadv = 17 schema PPM Semi Monotone (overshoots autorisés) c iadv = 18 schema PPM Positif Defini (overshoots undershoots autorisés) c iadv = 20 schema Slopes c iadv = 30 schema Prather c c Dans le tableau q(ij,l,iq) : iq = 1 pour l'eau vapeur c iq = 2 pour l'eau liquide c Et eventuellement iq = 3,nqmx pour les autres traceurs c c iadv(1): choix pour l'eau vap. et iadv(2) : choix pour l'eau liq. C------------------------------------------------------------------------ c Choix du schema d'advection c------------------------------------------------------------------ c choix par defaut = van leer pour tous les traceurs do iq=1,nqmx iadv(iq)=10 str1(1:1)='q' if (nqmx.le.99) then WRITE(str1(2:3),'(i2.2)') iq else WRITE(str1(2:4),'(i3.3)') iq endif tnom(iq)=str1 tname(iq)=tnom(iq) str2=tnom(iq) ttext(iq)=str2(1:lnblnk(str2))//descrq(iadv(iq)) end do nq=nqmx c------------------------------------------------------------------ c Choix du schema pour l'advection c dans fichier traceur.def c------------------------------------------------------------------ IF (config_inca /= 'none') THEN C le module de chimie fournit les noms des traceurs C et les schemas d'advection associes. tnom(1)='H2Ov' tnom(2)='H2Ol' nq=nbtrac+2 if (nq.gt.nqmx) then print*,'nombre de traceurs incompatible INCA/LMDZT', nq, nbtrac stop endif do iq =3,nq tnom(iq)=tracnam(iq-2) end do do iq =1,nq hadv(iq)= hadv_flg(iq) vadv(iq)= vadv_flg(iq) end do ELSE ! config_inca=none print*,'ouverture de traceur.def' open(90,file='traceur.def',form='formatted',status='old', s iostat=ierr) if(ierr.eq.0) then print*,'ouverture de traceur.def ok' read(90,*) nq print*,'nombre de traceurs ',nq if (nq.gt.nqmx) then print*,'nombre de traceurs trop important' print*,'verifier traceur.def' stop endif C do iq=1,nq read(90,999) hadv(iq),vadv(iq),tnom(iq) end do close(90) PRINT*,'lecture de traceur.def :' do iq=1,nq write(*,*) hadv(iq),vadv(iq),tnom(iq) end do else print*,'pb ouverture traceur.def' print*,'ATTENTION on prend des valeurs par defaut' nq = 4 hadv(1) = 14 vadv(1) = 14 tnom(1) = 'H2Ov' hadv(2) = 10 vadv(2) = 10 tnom(2) = 'H2Ol' hadv(3) = 10 vadv(3) = 10 tnom(3) = 'RN' hadv(4) = 10 vadv(4) = 10 tnom(4) = 'PB' ENDIF PRINT*,'Valeur de traceur.def :' do iq=1,nq write(*,*) hadv(iq),vadv(iq),tnom(iq) end do END IF ! config_inca c a partir du nom court du traceur et du schema d'advection au detemine le nom long. iiq=0 ii=0 do iq=1,nq iiq=iiq+1 if (hadv(iq).ne.vadv(iq)) then if (hadv(iq).eq.10.and.vadv(iq).eq.16) then iadv(iiq)=11 else print*,'le choix des schemas d''advection H et V' print*, 'est non disponible actuellement' stop endif else iadv(iiq)=hadv(iq) endif c verification nombre de traceurs if (iadv(iiq).lt.20) then ii=ii+1 elseif (iadv(iiq).eq.20) then ii=ii+4 elseif (iadv(iiq).eq.30) then ii=ii+10 endif str1=tnom(iq) tname(iiq)=tnom(iq) IF (iadv(iiq).eq.0) THEN ttext(iiq)=str1(1:lnblnk(str1)) ELSE ttext(iiq)=str1(1:lnblnk(str1))//descrq(iadv(iiq)) ENDIF str2=ttext(iiq) c schemas tenant compte des moments d'ordre superieur. if (iadv(iiq).eq.20) then do iiiq=1,3 iiq=iiq+1 iadv(iiq)=-20 ttext(iiq)=str2(1:lnblnk(str2))//txts(iiiq) tname(iiq)=str1(1:lnblnk(str1))//txts(iiiq) enddo elseif (iadv(iiq).eq.30) then do iiiq=1,9 iiq=iiq+1 iadv(iiq)=-30 ttext(iiq)=str2(1:lnblnk(str2))//txtp(iiiq) tname(iiq)=str1(1:lnblnk(str1))//txtp(iiiq) enddo endif end do if(ii.ne.nqmx) then print*,'WARNING' print*,'le nombre de traceurs et de moments eventuels' print*,'est inferieur a nqmx ' endif if (iiq.gt.nqmx) then print*,'le choix des schemas est incompatible avec ' print*,'la dimension nqmx (nombre de traceurs)' print*,'verifier traceur.def ou la namelist INCA' print*,'ou recompiler avec plus de traceurs' stop endif iiq=0 do iq=1,nqmx if(iadv(iq).ge.0) then iiq=iiq+1 niadv(iiq)=iq endif end do return 999 format (i2,1x,i2,1x,a8) END