source: LMDZ6/trunk/libf/phylmd/tracreprobus_mod.f90 @ 5935

Last change on this file since 5935 was 5935, checked in by lfalletti, 37 hours ago

Modifs pour corriger l'utilisation du wrapper clé CPP pour REPROBUS.

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 5.2 KB
Line 
1MODULE tracreprobus_mod
2!
3! This module prepares and calls the Reprobus main subroutine
4!
5
6CONTAINS
7
8  SUBROUTINE tracreprobus(pdtphys, gmtime, debutphy, julien, &
9       presnivs, xlat, xlon, pphis, pphi, &
10       t_seri, pplay, paprs, & !sh_in , &
11       tr_seri, ql_seri, qs_seri, q_seri)
12
13    USE dimphy
14    USE infotrac_phy, ONLY: nbtr
15    USE lmdz_reprobus_wrappers, ONLY : pdt_rep, &  ! pas de temps reprobus
16         daynum, iter, &             ! jourjulien, iteration chimie
17         pdel,&
18         d_q_rep,d_ql_rep,d_qi_rep, chemmain_rlong_1401
19    USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_REPROBUS
20    USE strataer_local_var_mod, ONLY: nSpeciesErupt, flag_emit, budg_emi, nErupt, &                       
21            injdur, year_emit_vol, mth_emit_vol, &             
22            day_emit_vol, altemiss_vol, sigma_alt_vol, &         
23            ponde_lonlat_vol, xlat_min_vol, xlat_max_vol, &
24            xlon_min_vol, xlon_max_vol, id_species, &
25            m_species_emiss_vol
26    IMPLICIT NONE
27
28! Input argument
29!---------------
30    REAL,INTENT(IN)    :: pdtphys    ! Pas d'integration pour la physique (seconde)
31    REAL,INTENT(IN)    :: gmtime     ! Heure courante
32    LOGICAL,INTENT(IN) :: debutphy   ! le flag de l'initialisation de la physique
33    INTEGER,INTENT(IN) :: julien     ! Jour julien
34
35    REAL,DIMENSION(klev),INTENT(IN)        :: presnivs! pressions approximat. des milieux couches (en PA)
36    REAL,DIMENSION(klon),INTENT(IN)        :: xlat    ! latitudes pour chaque point
37    REAL,DIMENSION(klon),INTENT(IN)        :: xlon    ! longitudes pour chaque point
38    REAL,DIMENSION(klon),INTENT(IN)        :: pphis   ! geopotentiel du sol
39    REAL,DIMENSION(klon,klev),INTENT(IN)   :: pphi    ! geopotentiel de chaque couche
40
41    REAL,DIMENSION(klon,klev),INTENT(IN)   :: t_seri  ! Temperature
42    REAL,DIMENSION(klon,klev),INTENT(IN)   :: pplay   ! pression pour le mileu de chaque couche (en Pa)
43    REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs   ! pression pour chaque inter-couche (en Pa)
44    REAL,DIMENSION(klon,klev),INTENT(IN)   :: ql_seri
45    REAL,DIMENSION(klon,klev),INTENT(IN)   :: qs_seri
46    REAL,DIMENSION(klon,klev),INTENT(IN)   :: q_seri
47
48
49! Output argument
50!----------------
51    REAL,DIMENSION(klon,klev,nbtr),INTENT(INOUT)  :: tr_seri ! Concentration Traceur [U/KgA] 
52 
53
54! Local variables
55!----------------
56    INTEGER :: it, k, niter
57
58IF (CPPKEY_REPROBUS) THEN
59    !   -- CHIMIE REPROBUS --
60!    pdt_rep=pdtphys/2.
61    niter=pdtphys/pdt_rep
62    write(*,*)'nb d appel de REPROBUS',niter
63   
64    DO k = 1, klev
65       pdel(:,k) = paprs(:,k) - paprs (:,k+1)
66    END DO
67   
68    ! initialisation de ozone passif a ozone en debut d hiver HN et HS
69    IF (julien == 341 .OR. julien == 181) THEN
70       tr_seri(:,:,11)=tr_seri(:,:,8)
71    END IF
72
73    d_q_rep(:,:)  =0.
74    d_ql_rep(:,:) =0.
75    d_qi_rep(:,:) =0.
76   
77    DO  iter = 1,niter
78       daynum = FLOAT(julien) + gmtime + (iter-1)*pdt_rep/86400.
79       
80!       DO it=1, nbtr
81!     WRITE(lunout,*)it,' ',minval(tr_seri(:,:,it)),maxval(tr_seri(:,:,it))
82! seulement pour les especes chimiques (pas l'age de l'air)
83! verif valeurs extremes
84! correction: a 1.e-30 quand =0 ou negatif et
85! call abort si >ou= 1.e10
86!          WRITE(*,*)it,'nqtot',nqtot,'nbtr',nbtr
87!          IF (it < nqtot) THEN
88!             WRITE(*,*)'iciav',it,nqtot
89!#ifdef REPROBUS
90!             CALL minmaxqfi_chimie(it,tr_seri(1,1,it),0.,1.e10,'avant chimie ')
91!#endif
92!             WRITE(*,*)iter,'avpres'
93!          ENDIF
94!       ENDDO
95       
96IF (CPPKEY_REPROBUS) THEN
97       CALL chemmain_rlong_1401( &
98            tr_seri, & !argument phytrac (change de nom apres: vmr)
99            xlon,    & !argument phytrac (change de nom apres: lon)
100            xlat,    & !argument phytrac (change de nom apres: lat)
101            t_seri,  & !argument phytrac (meme nom)
102            pplay,   & !argument phytrac (meme nom)
103            paprs,   &
104            pphi,    & !argument phytrac (meme nom)
105            pphis,   & !argument phytrac (meme nom)
106            presnivs, & !argument phytrac (meme nom)
107            debutphy, & !argument phytrac (change de nom apres: debut)
108            ql_seri, &
109            qs_seri, &
110            q_seri,  &
111            nSpeciesErupt, flag_emit, budg_emi, nErupt, &
112            injdur, year_emit_vol, mth_emit_vol, &
113            day_emit_vol, altemiss_vol, sigma_alt_vol, &
114            ponde_lonlat_vol, xlat_min_vol, xlat_max_vol, &
115            xlon_min_vol, xlon_max_vol, id_species, &
116            m_species_emiss_vol)
117       ! pdel, pdt_rep, daynum : definit dans phytrac et utilise dans chemmain
118       !                 et transporte par CHEM_REP
119
120!       DO it=1, nbtr
121!     WRITE(lunout,*)it,' ',minval(tr_seri(:,:,it)),maxval(tr_seri(:,:,it))
122! seulement pour les especes chimiques (pas l'age de l'air)
123! verif valeurs extremes
124! correction: a 1.e-30 quand =0 ou negatif et
125! call abort si >ou= 1.e10
126!          WRITE(*,*)it,'nqtot',nqtot,'nbtr',nbtr
127!          IF (it < nqtot) THEN
128!             WRITE(*,*)'iciap',it,nqtot
129!             CALL minmaxqfi_chimie(it,tr_seri(1,1,it),0.,1.e10,'apres chemmain')
130!             WRITE(*,*)iter,'appres'
131!          ENDIF
132!       ENDDO
133
134END IF
135       
136    END DO
137END IF
138  END SUBROUTINE tracreprobus
139
140END MODULE tracreprobus_mod
Note: See TracBrowser for help on using the repository browser.