source: LMDZ6/branches/LMDZ-tracers/libf/dyn3d/advtrac.F90 @ 4244

Last change on this file since 4244 was 3852, checked in by dcugnet, 4 years ago

Extension of the tracers management.

The tracers files can be:

1) "traceur.def": old format, with:

  • the number of tracers on the first line
  • one line for each tracer: <tracer name> <hadv> <vadv> [<parent name>]

2) "tracer.def": new format with one section each model component.
3) "tracer_<name>.def": new format with a single section.

The formats 2 and 3 reading is driven by the "type_trac" key, which can be a

coma-separated list of components.

  • Format 2: read the sections from the "tracer.def" file.
  • format 3: read one section each "tracer_<section name>.def" file.
  • the first line of a section is "&<section name>
  • the other lines start with a tracer name followed by <key>=<val> pairs.
  • the "default" tracer name is reserved ; the other tracers of the section inherit its <key>=<val>, except for the keys that are redefined locally.

This format helps keeping the tracers files compact, thanks to the "default"
special tracer and the three levels of factorization:

  • on the tracers names: a tracer name can be a coma-separated list of tracers => all the tracers of the list have the same <key>=<val> properties
  • on the parents names: the value of the "parent" property can be a coma-separated list of tracers => only possible for geographic tagging tracers
  • on the phases: the property "phases" is [g](l][s] (gas/liquid/solid)

Read information is stored in the vector "tracers(:)", of derived type "tra".

"isotopes_params.def" is a similar file, with one section each isotopes family.
It contains a database of isotopes properties ; if there are second generation
tracers (isotopes), the corresponding sections are read.

Read information is stored in the vector "isotopes(:)", of derived type "iso".

The "getKey" function helps to get the values of the parameters stored in
"tracers" or "isotopes".
  • 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
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 14.6 KB
Line 
1! $Id: advtrac.F90 3852 2021-02-22 16:28:31Z dcugnet $
2
3SUBROUTINE advtrac(pbaru,pbarv , p,  masse,q,iapptrac,teta, flxw, pk)
4  !     Auteur :  F. Hourdin
5  !
6  !     Modif. P. Le Van     (20/12/97)
7  !            F. Codron     (10/99)
8  !            D. Le Croller (07/2001)
9  !            M.A Filiberti (04/2002)
10  !
11  USE infotrac, ONLY: nqtot, tracers
12  USE control_mod, ONLY: iapp_tracvl, day_step
13  USE comconst_mod, ONLY: dtvr
14
15  IMPLICIT NONE
16  !
17  include "dimensions.h"
18  include "paramet.h"
19  include "comdissip.h"
20  include "comgeom2.h"
21  include "description.h"
22  include "iniprint.h"
23
24  !-------------------------------------------------------------------
25  !     Arguments
26  !-------------------------------------------------------------------
27  INTEGER,INTENT(OUT) :: iapptrac
28  REAL,INTENT(IN) :: pbaru(ip1jmp1,llm)
29  REAL,INTENT(IN) :: pbarv(ip1jm,llm)
30  REAL,INTENT(INOUT) :: q(ip1jmp1,llm,nqtot)
31  REAL,INTENT(IN) :: masse(ip1jmp1,llm)
32  REAL,INTENT(IN) :: p( ip1jmp1,llmp1 )
33  REAL,INTENT(IN) :: teta(ip1jmp1,llm)
34  REAL,INTENT(IN) :: pk(ip1jmp1,llm)
35  REAL,INTENT(OUT) :: flxw(ip1jmp1,llm)
36  !-------------------------------------------------------------------
37  !     Ajout PPM
38  !--------------------------------------------------------
39  REAL massebx(ip1jmp1,llm),masseby(ip1jm,llm)
40  !-------------------------------------------------------------
41  !     Variables locales
42  !-------------------------------------------------------------
43
44  REAL pbaruc(ip1jmp1,llm),pbarvc(ip1jm,llm)
45  REAL massem(ip1jmp1,llm),zdp(ip1jmp1)
46  REAL pbarug(ip1jmp1,llm),pbarvg(ip1jm,llm),wg(ip1jmp1,llm)
47  REAL (kind=kind(1.d0)) :: t_initial, t_final, tps_cpu
48  INTEGER iadvtr
49  INTEGER ij,l,iq,iiq
50  INTEGER, POINTER :: iadv(:)
51  REAL zdpmin, zdpmax
52  EXTERNAL  minmax
53  SAVE iadvtr, massem, pbaruc, pbarvc
54  DATA iadvtr/0/
55  !----------------------------------------------------------
56  !     Rajouts pour PPM
57  !----------------------------------------------------------
58  INTEGER indice,n
59  REAL dtbon ! Pas de temps adaptatif pour que CFL<1
60  REAL CFLmaxz,aaa,bbb ! CFL maximum
61  REAL psppm(iim,jjp1) ! pression  au sol
62  REAL unatppm(iim,jjp1,llm),vnatppm(iim,jjp1,llm)
63  REAL qppm(iim*jjp1,llm,nqtot)
64  REAL fluxwppm(iim,jjp1,llm)
65  REAL apppm(llmp1), bpppm(llmp1)
66  LOGICAL dum,fill
67  DATA fill/.true./
68  DATA dum/.true./
69
70  integer,save :: countcfl=0
71  real cflx(ip1jmp1,llm)
72  real cfly(ip1jm,llm)
73  real cflz(ip1jmp1,llm)
74  real, save :: cflxmax(llm),cflymax(llm),cflzmax(llm)
75
76  iadv => tracers(:)%iadv
77
78  IF(iadvtr.EQ.0) THEN
79     pbaruc(:,:)=0
80     pbarvc(:,:)=0
81  ENDIF
82
83  !   accumulation des flux de masse horizontaux
84  DO l=1,llm
85     DO ij = 1,ip1jmp1
86        pbaruc(ij,l) = pbaruc(ij,l) + pbaru(ij,l)
87     ENDDO
88     DO ij = 1,ip1jm
89        pbarvc(ij,l) = pbarvc(ij,l) + pbarv(ij,l)
90     ENDDO
91  ENDDO
92
93  !   selection de la masse instantannee des mailles avant le transport.
94  IF(iadvtr.EQ.0) THEN
95
96     CALL SCOPY(ip1jmp1*llm,masse,1,massem,1)
97     !cc         CALL filtreg ( massem ,jjp1, llm,-2, 2, .TRUE., 1 )
98     !
99  ENDIF
100
101  iadvtr   = iadvtr+1
102  iapptrac = iadvtr
103
104
105  !   Test pour savoir si on advecte a ce pas de temps
106  IF ( iadvtr.EQ.iapp_tracvl ) THEN
107
108     !c   ..  Modif P.Le Van  ( 20/12/97 )  ....
109     !c
110
111     !   traitement des flux de masse avant advection.
112     !     1. calcul de w
113     !     2. groupement des mailles pres du pole.
114
115     CALL groupe( massem, pbaruc,pbarvc, pbarug,pbarvg,wg )
116
117     ! ... Flux de masse diaganostiques traceurs
118     flxw = wg / REAL(iapp_tracvl)
119
120     !  test sur l'eventuelle creation de valeurs negatives de la masse
121     DO l=1,llm-1
122        DO ij = iip2+1,ip1jm
123           zdp(ij) =    pbarug(ij-1,l)   - pbarug(ij,l) &
124                - pbarvg(ij-iip1,l) + pbarvg(ij,l) &
125                +       wg(ij,l+1)  - wg(ij,l)
126        ENDDO
127        CALL SCOPY( jjm -1 ,zdp(iip1+iip1),iip1,zdp(iip2),iip1 )
128        DO ij = iip2,ip1jm
129           zdp(ij)= zdp(ij)*dtvr/ massem(ij,l)
130        ENDDO
131
132
133        CALL minmax ( ip1jm-iip1, zdp(iip2), zdpmin,zdpmax )
134
135        IF(MAX(ABS(zdpmin),ABS(zdpmax)).GT.0.5) THEN
136           PRINT*,'WARNING DP/P l=',l,'  MIN:',zdpmin, &
137                '   MAX:', zdpmax
138        ENDIF
139
140     ENDDO
141
142
143     !-------------------------------------------------------------------
144     ! Calcul des criteres CFL en X, Y et Z
145     !-------------------------------------------------------------------
146
147     if (countcfl == 0. ) then
148        cflxmax(:)=0.
149        cflymax(:)=0.
150        cflzmax(:)=0.
151     endif
152
153     countcfl=countcfl+iapp_tracvl
154     cflx(:,:)=0.
155     cfly(:,:)=0.
156     cflz(:,:)=0.
157     do l=1,llm
158        do ij=iip2,ip1jm-1
159           if (pbarug(ij,l)>=0.) then
160              cflx(ij,l)=pbarug(ij,l)*dtvr/masse(ij,l)
161           else
162              cflx(ij,l)=-pbarug(ij,l)*dtvr/masse(ij+1,l)
163           endif
164        enddo
165     enddo
166     do l=1,llm
167        do ij=iip2,ip1jm-1,iip1
168           cflx(ij+iip1,l)=cflx(ij,l)
169        enddo
170     enddo
171
172     do l=1,llm
173        do ij=1,ip1jm
174           if (pbarvg(ij,l)>=0.) then
175              cfly(ij,l)=pbarvg(ij,l)*dtvr/masse(ij,l)
176           else
177              cfly(ij,l)=-pbarvg(ij,l)*dtvr/masse(ij+iip1,l)
178           endif
179        enddo
180     enddo
181
182     do l=2,llm
183        do ij=1,ip1jm
184           if (wg(ij,l)>=0.) then
185              cflz(ij,l)=wg(ij,l)*dtvr/masse(ij,l)
186           else
187              cflz(ij,l)=-wg(ij,l)*dtvr/masse(ij,l-1)
188           endif
189        enddo
190     enddo
191
192     do l=1,llm
193        cflxmax(l)=max(cflxmax(l),maxval(cflx(:,l)))
194        cflymax(l)=max(cflymax(l),maxval(cfly(:,l)))
195        cflzmax(l)=max(cflzmax(l),maxval(cflz(:,l)))
196     enddo
197
198!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
199     ! Par defaut, on sort le diagnostic des CFL tous les jours.
200     ! Si on veut le sortir a chaque pas d'advection en cas de plantage
201     !     if (countcfl==iapp_tracvl) then
202!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
203     if (countcfl==day_step) then
204        do l=1,llm
205           write(lunout,*) 'L, CFL[xyz]max:', l, cflxmax(l), cflymax(l), &
206                cflzmax(l)
207        enddo
208        countcfl=0
209     endif
210
211     !-------------------------------------------------------------------
212     !   Advection proprement dite (Modification Le Croller (07/2001)
213     !-------------------------------------------------------------------
214
215     !----------------------------------------------------
216     !        Calcul des moyennes basées sur la masse
217     !----------------------------------------------------
218     call massbar(massem,massebx,masseby)         
219
220     !-----------------------------------------------------------
221     !     Appel des sous programmes d'advection
222     !-----------------------------------------------------------
223
224     call check_isotopes_seq(q,ip1jmp1,'advtrac 162')
225
226     do iq=1,nqtot
227        !        call clock(t_initial)
228        if(iadv(iq) == 0 .OR. tracers(iq)%igen /= 1) cycle
229        !   ----------------------------------------------------------------
230        !   Schema de Van Leer I MUSCL
231        !   ----------------------------------------------------------------
232        if(iadv(iq).eq.10) THEN
233           ! CRisi: on fait passer tout q pour avoir acces aux fils
234           
235           !write(*,*) 'advtrac 239: iq,q(1721,19,:)=',iq,q(1721,19,:)     
236           call vlsplt(q,2.,massem,wg,pbarug,pbarvg,dtvr,iq)
237           
238           !   ----------------------------------------------------------------
239           !   Schema "pseudo amont" + test sur humidite specifique
240           !    pour la vapeur d'eau. F. Codron
241           !   ----------------------------------------------------------------
242        else if(iadv(iq).eq.14) then
243           !
244           !write(*,*) 'advtrac 248: iq,q(1721,19,:)=',iq,q(1721,19,:)
245           CALL vlspltqs( q, 2., massem, wg , &
246                pbarug,pbarvg,dtvr,p,pk,teta,iq)
247           
248           !   ----------------------------------------------------------------
249           !   Schema de Frederic Hourdin
250           !   ----------------------------------------------------------------
251        else if(iadv(iq).eq.12) then
252           !            Pas de temps adaptatif
253           call adaptdt(iadv(iq),dtbon,n,pbarug,massem)
254           if (n.GT.1) then
255              write(*,*) 'WARNING horizontal dt=',dtbon,'dtvr=', &
256                   dtvr,'n=',n
257           endif
258           do indice=1,n
259              call advn(q(1,1,iq),massem,wg,pbarug,pbarvg,dtbon,1)
260           end do
261        else if(iadv(iq).eq.13) then
262           !            Pas de temps adaptatif
263           call adaptdt(iadv(iq),dtbon,n,pbarug,massem)
264           if (n.GT.1) then
265              write(*,*) 'WARNING horizontal dt=',dtbon,'dtvr=', &
266                   dtvr,'n=',n
267           endif
268           do indice=1,n
269              call advn(q(1,1,iq),massem,wg,pbarug,pbarvg,dtbon,2)
270           end do
271           !   ----------------------------------------------------------------
272           !   Schema de pente SLOPES
273           !   ----------------------------------------------------------------
274        else if (iadv(iq).eq.20) then
275           call pentes_ini (q(1,1,iq),wg,massem,pbarug,pbarvg,0)
276
277           !   ----------------------------------------------------------------
278           !   Schema de Prather
279           !   ----------------------------------------------------------------
280        else if (iadv(iq).eq.30) then
281           !            Pas de temps adaptatif
282           call adaptdt(iadv(iq),dtbon,n,pbarug,massem)
283           if (n.GT.1) then
284              write(*,*) 'WARNING horizontal dt=',dtbon,'dtvr=', &
285                   dtvr,'n=',n
286           endif
287           call  prather(q(1,1,iq),wg,massem,pbarug,pbarvg, &
288                n,dtbon)
289
290           !   ----------------------------------------------------------------
291           !   Schemas PPM Lin et Rood
292           !   ----------------------------------------------------------------
293        else if (iadv(iq).eq.11.OR.(iadv(iq).GE.16.AND. &
294             iadv(iq).LE.18)) then
295
296           !        Test sur le flux horizontal
297           !        Pas de temps adaptatif
298           call adaptdt(iadv(iq),dtbon,n,pbarug,massem)
299           if (n.GT.1) then
300              write(*,*) 'WARNING horizontal dt=',dtbon,'dtvr=', &
301                   dtvr,'n=',n
302           endif
303           !        Test sur le flux vertical
304           CFLmaxz=0.
305           do l=2,llm
306              do ij=iip2,ip1jm
307                 aaa=wg(ij,l)*dtvr/massem(ij,l)
308                 CFLmaxz=max(CFLmaxz,aaa)
309                 bbb=-wg(ij,l)*dtvr/massem(ij,l-1)
310                 CFLmaxz=max(CFLmaxz,bbb)
311              enddo
312           enddo
313           if (CFLmaxz.GE.1) then
314              write(*,*) 'WARNING vertical','CFLmaxz=', CFLmaxz
315           endif
316
317           !-----------------------------------------------------------
318           !        Ss-prg interface LMDZ.4->PPM3d
319           !-----------------------------------------------------------
320
321           call interpre(q(1,1,iq),qppm(1,1,iq),wg,fluxwppm,massem, &
322                apppm,bpppm,massebx,masseby,pbarug,pbarvg, &
323                unatppm,vnatppm,psppm)
324
325           do indice=1,n
326              !----------------------------------------------------------------
327              !                         VL (version PPM) horiz. et PPM vert.
328              !----------------------------------------------------------------
329              if (iadv(iq).eq.11) then
330                 !                  Ss-prg PPM3d de Lin
331                 call ppm3d(1,qppm(1,1,iq), &
332                      psppm,psppm, &
333                      unatppm,vnatppm,fluxwppm,dtbon,2,2,2,1, &
334                      iim,jjp1,2,llm,apppm,bpppm,0.01,6400000, &
335                      fill,dum,220.)
336
337                 !-------------------------------------------------------------
338                 !                           Monotonic PPM
339                 !-------------------------------------------------------------
340              else if (iadv(iq).eq.16) then
341                 !                  Ss-prg PPM3d de Lin
342                 call ppm3d(1,qppm(1,1,iq), &
343                      psppm,psppm, &
344                      unatppm,vnatppm,fluxwppm,dtbon,3,3,3,1, &
345                      iim,jjp1,2,llm,apppm,bpppm,0.01,6400000, &
346                      fill,dum,220.)
347                 !-------------------------------------------------------------
348
349                 !-------------------------------------------------------------
350                 !                           Semi Monotonic PPM
351                 !-------------------------------------------------------------
352              else if (iadv(iq).eq.17) then
353                 !                  Ss-prg PPM3d de Lin
354                 call ppm3d(1,qppm(1,1,iq), &
355                      psppm,psppm, &
356                      unatppm,vnatppm,fluxwppm,dtbon,4,4,4,1, &
357                      iim,jjp1,2,llm,apppm,bpppm,0.01,6400000, &
358                      fill,dum,220.)
359                 !-------------------------------------------------------------
360
361                 !-------------------------------------------------------------
362                 !                         Positive Definite PPM
363                 !-------------------------------------------------------------
364              else if (iadv(iq).eq.18) then
365                 !                  Ss-prg PPM3d de Lin
366                 call ppm3d(1,qppm(1,1,iq), &
367                      psppm,psppm, &
368                      unatppm,vnatppm,fluxwppm,dtbon,5,5,5,1, &
369                      iim,jjp1,2,llm,apppm,bpppm,0.01,6400000, &
370                      fill,dum,220.)
371                 !-------------------------------------------------------------
372              endif
373           enddo
374           !-----------------------------------------------------------------
375           !               Ss-prg interface PPM3d-LMDZ.4
376           !-----------------------------------------------------------------
377           call interpost(q(1,1,iq),qppm(1,1,iq))
378        endif
379        !----------------------------------------------------------------------
380
381        !-----------------------------------------------------------------
382        ! On impose une seule valeur du traceur au pôle Sud j=jjm+1=jjp1
383        ! et Nord j=1
384        !-----------------------------------------------------------------
385
386        !                  call traceurpole(q(1,1,iq),massem)
387
388        ! calcul du temps cpu pour un schema donne
389
390        !                  call clock(t_final)
391        !ym                  tps_cpu=t_final-t_initial
392        !ym                  cpuadv(iq)=cpuadv(iq)+tps_cpu
393
394     end DO
395
396     call check_isotopes_seq(q,ip1jmp1,'advtrac 397')
397
398     !------------------------------------------------------------------
399     !   on reinitialise a zero les flux de masse cumules
400     !---------------------------------------------------
401     iadvtr=0
402
403  ENDIF ! if iadvtr.EQ.iapp_tracvl
404
405END SUBROUTINE advtrac
Note: See TracBrowser for help on using the repository browser.