Ignore:
Timestamp:
Feb 22, 2021, 5:28:31 PM (4 years ago)
Author:
dcugnet
Message:

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".

File:
1 moved

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/LMDZ-tracers/libf/dyn3dmem/vlspltgen_loc.F90

    r3850 r3852  
     1SUBROUTINE vlspltgen_loc( q,iadv,pente_max,masse,w,pbaru,pbarv,pdt,p,pk,teta)
     2
     3!  Auteurs:   P.Le Van, F.Hourdin, F.Forget, F.Codron
    14!
    2 ! $Header$
     5! ********************************************************************
     6!       Shema  d'advection " pseudo amont " .
     7!   + test sur humidite specifique: Q advecte< Qsat aval
     8!               (F. Codron, 10/99)
     9! ********************************************************************
     10!  q,pbaru,pbarv,w sont des arguments d'entree  pour le s-pg ....
    311!
    4        SUBROUTINE vlspltgen_loc( q,iadv,pente_max,masse,w,pbaru,pbarv,
    5      &                           pdt, p,pk,teta                 )
    6      
    7 c
    8 c     Auteurs:   P.Le Van, F.Hourdin, F.Forget, F.Codron
    9 c
    10 c    ********************************************************************
    11 c          Shema  d'advection " pseudo amont " .
    12 c      + test sur humidite specifique: Q advecte< Qsat aval
    13 c                   (F. Codron, 10/99)
    14 c    ********************************************************************
    15 c     q,pbaru,pbarv,w sont des arguments d'entree  pour le s-pg ....
    16 c
    17 c     pente_max facteur de limitation des pentes: 2 en general
    18 c                                                0 pour un schema amont
    19 c     pbaru,pbarv,w flux de masse en u ,v ,w
    20 c     pdt pas de temps
    21 c
    22 c     teta temperature potentielle, p pression aux interfaces,
    23 c     pk exner au milieu des couches necessaire pour calculer Qsat
    24 c   --------------------------------------------------------------------
    25       USE parallel_lmdz
    26       USE mod_hallo
    27       USE Write_Field_loc
    28       USE VAMPIR
    29       ! CRisi: on rajoute variables utiles d'infotrac 
    30       USE infotrac, ONLY : nqtot,nqperes,nqdesc,nqfils,iqfils,
    31      &    ok_iso_verif
    32       USE vlspltgen_mod
    33       USE comconst_mod, ONLY: cpp
    34       IMPLICIT NONE
    35 
    36 c
    37       include "dimensions.h"
    38       include "paramet.h"
    39 
    40 c
    41 c   Arguments:
    42 c   ----------
    43       INTEGER iadv(nqtot)
    44       REAL masse(ijb_u:ije_u,llm),pente_max
    45       REAL pbaru( ijb_u:ije_u,llm ),pbarv( ijb_v:ije_v,llm)
    46       REAL q(ijb_u:ije_u,llm,nqtot)
    47       REAL w(ijb_u:ije_u,llm),pdt
    48       REAL p(ijb_u:ije_u,llmp1),teta(ijb_u:ije_u,llm)
    49       REAL pk(ijb_u:ije_u,llm)
    50 c
    51 c      Local
    52 c   ---------
    53 c
    54       INTEGER ij,l
    55 c
    56       REAL zzpbar, zzw
    57 
    58       REAL qmin,qmax
    59       DATA qmin,qmax/0.,1.e33/
    60 
    61 c--pour rapport de melange saturant--
    62 
    63       REAL rtt,retv,r2es,r3les,r3ies,r4les,r4ies,play
    64       REAL ptarg,pdelarg,foeew,zdelta
    65       REAL tempe(ijb_u:ije_u)
    66       INTEGER ijb,ije,iq,iq2,ifils
    67       LOGICAL, SAVE :: firstcall=.TRUE.
     12!  pente_max facteur de limitation des pentes: 2 en general
     13!                                            0 pour un schema amont
     14!  pbaru,pbarv,w flux de masse en u ,v ,w
     15!  pdt pas de temps
     16!
     17!  teta temperature potentielle, p pression aux interfaces,
     18!  pk exner au milieu des couches necessaire pour calculer Qsat
     19!--------------------------------------------------------------------
     20  USE parallel_lmdz
     21  USE mod_hallo
     22  USE Write_Field_loc
     23  USE VAMPIR
     24  USE infotrac, ONLY : nqtot, tracers, tra
     25  USE vlspltgen_mod
     26  USE comconst_mod, ONLY: cpp
     27  IMPLICIT NONE
     28
     29  include "dimensions.h"
     30  include "paramet.h"
     31
     32!
     33! Arguments:
     34!----------
     35  REAL, DIMENSION(ijb_u:ije_u,llm,nqtot), INTENT(INOUT) :: q
     36  INTEGER, DIMENSION(nqtot),              INTENT(IN)    :: iadv
     37  REAL,                                   INTENT(IN)    :: pdt, pente_max
     38  REAL, DIMENSION(ijb_u:ije_u,llm),       INTENT(IN)    :: pk, pbaru, masse, w, teta
     39  REAL, DIMENSION(ijb_v:ije_v,llm),       INTENT(IN)    ::     pbarv
     40  REAL, DIMENSION(ijb_u:ije_u,llmp1),     INTENT(IN)    :: p
     41!
     42! Local
     43!---------
     44  INTEGER :: ij, l
     45  REAL    :: zzpbar, zzw
     46  REAL, PARAMETER :: qmin = 0., qmax = 1.e33
     47  TYPE(tra), POINTER :: tr
     48
     49!--pour rapport de melange saturant--
     50  REAL, PARAMETER ::   &
     51    r2es  = 380.11733, &
     52    r3les = 17.269,    &
     53    r3ies = 21.875,    &
     54    r4les = 35.86,     &
     55    r4ies = 7.66,      &
     56    retv  = 0.6077667, &
     57    rtt   = 273.16
     58
     59  REAL    :: play, ptarg, pdelarg, foeew, zdelta, tempe(ijb_u:ije_u)
     60  INTEGER :: ijb,ije,iq,iq2,ichld
     61  LOGICAL, SAVE :: firstcall=.TRUE.
    6862!$OMP THREADPRIVATE(firstcall)
    69       type(request),SAVE :: MyRequest1
    70 !$OMP THREADPRIVATE(MyRequest1)
    71       type(request),SAVE :: MyRequest2
    72 !$OMP THREADPRIVATE(MyRequest2)
    73 c    fonction psat(T)
    74 
    75        FOEEW ( PTARG,PDELARG ) = EXP (
    76      *          (R3LES*(1.-PDELARG)+R3IES*PDELARG) * (PTARG-RTT)
    77      * / (PTARG-(R4LES*(1.-PDELARG)+R4IES*PDELARG)) )
    78 
    79         r2es  = 380.11733
    80         r3les = 17.269
    81         r3ies = 21.875
    82         r4les = 35.86
    83         r4ies = 7.66
    84         retv = 0.6077667
    85         rtt  = 273.16
    86 
    87 c Allocate variables depending on dynamic variable nqtot
    88 
    89          IF (firstcall) THEN
    90             firstcall=.FALSE.
    91          END IF
    92 c-- Calcul de Qsat en chaque point
    93 c-- approximation: au milieu des couches play(l)=(p(l)+p(l+1))/2
    94 c   pour eviter une exponentielle.
    95 
    96       call SetTag(MyRequest1,100)
    97       call SetTag(MyRequest2,101)
    98 
     63  TYPE(request), SAVE :: MyRequest1, MyRequest2
     64!$OMP THREADPRIVATE     (MyRequest1, MyRequest2)
     65
     66!    fonction psat(T)
     67  FOEEW ( PTARG,PDELARG ) = EXP ( (R3LES*(1.-PDELARG)+R3IES*PDELARG) * (PTARG-RTT) &
     68                         / (PTARG-(R4LES*(1.-PDELARG)+R4IES*PDELARG)) )
     69
     70! Allocate variables depending on dynamic variable nqtot
     71  IF(firstcall) THEN
     72     firstcall=.FALSE.
     73  END IF
     74!-- Calcul de Qsat en chaque point
     75!-- approximation: au milieu des couches play(l)=(p(l)+p(l+1))/2
     76!   pour eviter une exponentielle.
     77
     78  CALL SetTag(MyRequest1,100)
     79  CALL SetTag(MyRequest2,101)
     80
     81  ijb=ij_begin-iip1; IF(pole_nord) ijb=ij_begin
     82  ije=ij_end  +iip1; IF(pole_sud)  ije=ij_end
     83
     84!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     85  DO l = 1, llm
     86    DO ij = ijb, ije
     87      tempe(ij) = teta(ij,l) * pk(ij,l) /cpp
     88    END DO
     89    DO ij = ijb, ije
     90      zdelta = MAX( 0., SIGN(1., rtt - tempe(ij)) )
     91      play   = 0.5*(p(ij,l)+p(ij,l+1))
     92      qsat(ij,l) = MIN(0.5, r2es* FOEEW(tempe(ij),zdelta) / play )
     93      qsat(ij,l) = qsat(ij,l) / ( 1. - retv * qsat(ij,l) )
     94    END DO
     95  END DO
     96!$OMP END DO NOWAIT
     97!     PRINT*,'Debut vlsplt version debug sans vlyqs'
     98
     99  zzpbar = 0.5 * pdt
     100  zzw    = pdt
     101
     102  ijb=ij_begin; IF(pole_nord) ijb=ijb+iip1
     103  ije=ij_end;   IF(pole_sud)  ije=ije-iip1
     104!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
     105  DO l=1,llm
     106    DO ij = ijb,ije
     107      mu(ij,l)=pbaru(ij,l) * zzpbar
     108    END DO
     109  END DO
     110!$OMP END DO NOWAIT
     111     
     112  ijb=ij_begin-iip1; IF(pole_nord) ijb=ij_begin
     113  ije=ij_end;        IF(pole_sud)  ije=ij_end-iip1
     114!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     115  DO l=1,llm
     116    DO ij=ijb,ije
     117      mv(ij,l)=pbarv(ij,l) * zzpbar
     118    END DO
     119  END DO
     120!$OMP END DO NOWAIT
     121
     122  ijb=ij_begin
     123  ije=ij_end
     124  DO iq=1,nqtot
     125!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
     126    DO l=1,llm
     127      DO ij=ijb,ije
     128        mw(ij,l,iq)=w(ij,l) * zzw
     129      END DO
     130    END DO
     131!$OMP END DO NOWAIT
     132  END DO
     133
     134  DO iq=1,nqtot 
     135!$OMP MASTER
     136    DO ij=ijb,ije
     137      mw(ij,llm+1,iq)=0.
     138    END DO
     139!$OMP END MASTER
     140  END DO
     141
     142!  CALL SCOPY(ijp1llm,q,1,zq,1)
     143!  CALL SCOPY(ijp1llm,masse,1,zm,1)
     144
     145  ijb=ij_begin
     146  ije=ij_end
     147  DO iq=1,nqtot       
     148!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     149    DO l=1,llm
     150      zq(ijb:ije,l,iq)=q(ijb:ije,l,iq)
     151      zm(ijb:ije,l,iq)=masse(ijb:ije,l)
     152    END DO
     153!$OMP END DO NOWAIT
     154  END DO
     155
     156#ifdef DEBUG_IO     
     157  CALL WriteField_u('mu',mu)
     158  CALL WriteField_v('mv',mv)
     159  CALL WriteField_u('mw',mw)
     160  CALL WriteField_u('qsat',qsat)
     161#endif
     162
     163  ! verif temporaire
     164  ijb=ij_begin
     165  ije=ij_end 
     166  CALL check_isotopes(zq,ijb,ije,'vlspltgen_loc 191')
     167
     168!$OMP BARRIER           
     169  DO iq=1,nqtot
     170    tr => tracers(iq)
     171    ! CRisi: on ne boucle que sur les parents = ceux qui sont transportes directement par l'air
     172    IF(tr%igen /= 1) CYCLE
     173!    write(*,*) 'vlspltgen 192: iq,iadv=',iq,iadv(iq)
     174#ifdef DEBUG_IO   
     175    CALL WriteField_u('zq',zq(:,:,iq))
     176    CALL WriteField_u('zm',zm(:,:,iq))
     177#endif
     178    !----------------------------------------------------------------------
     179    SELECT CASE(iadv(iq))
     180    !----------------------------------------------------------------------
     181      CASE(0); CYCLE
     182    !----------------------------------------------------------------------
     183      CASE(10)
     184#ifdef _ADV_HALO       
     185        ! CRisi: on ajoute les nombres de fils et tableaux des fils
     186        ! On suppose qu'on ne peut advecter les fils que par le schéma 10. 
     187        CALL vlx_loc(zq,pente_max,zm,mu,ij_begin,ij_begin+2*iip1-1,iq)
     188        CALL vlx_loc(zq,pente_max,zm,mu,ij_end-2*iip1+1,ij_end,iq)
     189#else
     190        CALL vlx_loc(zq,pente_max,zm,mu,ij_begin,ij_end,iq)
     191#endif
     192!$OMP MASTER
     193        CALL VTb(VTHallo)
     194!$OMP END MASTER
     195        CALL Register_Hallo_u(zq(:,:,iq),llm,2,2,2,2,MyRequest1)
     196        CALL Register_Hallo_u(zm(:,:,iq),llm,1,1,1,1,MyRequest1)
     197! CRisi
     198        DO ichld=1,tr%ndesc
     199          iq2=tr%idesc(ichld)
     200          CALL Register_Hallo_u(zq(:,:,iq2),llm,2,2,2,2,MyRequest1)
     201          CALL Register_Hallo_u(zm(:,:,iq2),llm,1,1,1,1,MyRequest1)
     202        END DO
     203!$OMP MASTER
     204        CALL VTe(VTHallo)
     205!$OMP END MASTER
     206    !----------------------------------------------------------------------
     207      CASE(14)
     208#ifdef _ADV_HALO           
     209        CALL vlxqs_loc(zq,pente_max,zm,mu,qsat,ij_begin,ij_begin+2*iip1-1,iq)
     210        CALL vlxqs_loc(zq,pente_max,zm,mu,qsat,ij_end-2*iip1+1,ij_end,iq)
     211#else
     212        CALL vlxqs_loc(zq,pente_max,zm,mu,qsat,ij_begin,ij_end,iq)
     213#endif
     214!$OMP MASTER
     215        CALL VTb(VTHallo)
     216!$OMP END MASTER
     217        CALL Register_Hallo_u(zq(:,:,iq),llm,2,2,2,2,MyRequest1)
     218        CALL Register_Hallo_u(zm(:,:,iq),llm,1,1,1,1,MyRequest1)
     219        DO ichld=1,tr%ndesc
     220          iq2=tr%idesc(ichld)
     221          CALL Register_Hallo_u(zq(:,:,iq2),llm,2,2,2,2,MyRequest1)
     222          CALL Register_Hallo_u(zm(:,:,iq2),llm,1,1,1,1,MyRequest1)
     223        END DO
     224!$OMP MASTER
     225        CALL VTe(VTHallo)
     226!$OMP END MASTER
     227    !----------------------------------------------------------------------
     228      CASE DEFAULT; STOP 'vlspltgen_p : schema non parallelise'
     229    !----------------------------------------------------------------------
     230    END SELECT
     231    !----------------------------------------------------------------------
     232  END DO
     233!$OMP BARRIER     
     234
     235!$OMP MASTER     
     236  CALL VTb(VTHallo)
     237!$OMP END MASTER
     238  CALL SendRequest(MyRequest1)
     239!$OMP MASTER
     240  CALL VTe(VTHallo)
     241!$OMP END MASTER       
     242
     243!$OMP BARRIER
     244
     245  ! verif temporaire
     246  ijb=ij_begin-2*iip1; IF(pole_nord) ijb=ij_begin
     247  ije=ij_end  +2*iip1; IF(pole_sud)  ije=ij_end
     248  CALL check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 280')
     249
     250  DO iq=1,nqtot
     251    tr => tracers(iq)
     252!    write(*,*) 'vlspltgen 279: iq=',iq
     253    IF(tr%igen /= 1) CYCLE
     254    !----------------------------------------------------------------------
     255    SELECT CASE(iadv(iq))
     256    !----------------------------------------------------------------------
     257      CASE(0); CYCLE
     258    !----------------------------------------------------------------------
     259      CASE(10)
     260#ifdef _ADV_HALLO
     261        CALL vlx_loc(zq,pente_max,zm,mu,ij_begin+2*iip1,ij_end-2*iip1,iq)
     262#endif
     263    !----------------------------------------------------------------------
     264      CASE(14)
     265#ifdef _ADV_HALLO
     266        CALL vlxqs_loc(zq,pente_max,zm,mu,qsat,ij_begin+2*iip1,ij_end-2*iip1,iq)
     267#endif
     268      CASE DEFAULT; STOP 'vlspltgen_p : schema non parallelise'
     269    !----------------------------------------------------------------------
     270    END SELECT
     271    !----------------------------------------------------------------------
     272  END DO
     273!$OMP BARRIER     
     274
     275!$OMP MASTER
     276  CALL VTb(VTHallo)
     277!$OMP END MASTER
     278
     279!  CALL WaitRecvRequest(MyRequest1)
     280!  CALL WaitSendRequest(MyRequest1)
     281!$OMP BARRIER
     282  CALL WaitRequest(MyRequest1)
     283
     284
     285!$OMP MASTER
     286  CALL VTe(VTHallo)
     287!$OMP END MASTER
     288!$OMP BARRIER
     289
     290  CALL check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 326')
     291
     292  ijb=ij_begin-2*iip1; IF(pole_nord) ijb=ij_begin
     293  ije=ij_end  +2*iip1; IF(pole_sud)  ije=ij_end
     294
     295  CALL check_isotopes(zq,ijb,ije,'vlspltgen_loc 336')
     296
     297  DO iq=1,nqtot
     298    tr => tracers(iq)
     299!    write(*,*) 'vlspltgen 321: iq=',iq
     300    IF(tr%igen /= 1) CYCLE
     301#ifdef DEBUG_IO   
     302    CALL WriteField_u('zq',zq(:,:,iq))
     303    CALL WriteField_u('zm',zm(:,:,iq))
     304#endif
     305    !----------------------------------------------------------------------
     306    SELECT CASE(iadv(iq))
     307      CASE(0); CYCLE
     308      CASE(10); CALL   vly_loc(zq,pente_max,zm,mv,iq)
     309      CASE(14); CALL vlyqs_loc(zq,pente_max,zm,mv,qsat,iq)
     310      CASE DEFAULT; STOP 'vlspltgen_p : schema non parallelise'
     311    END SELECT
     312    !----------------------------------------------------------------------
     313  END DO
     314
     315  CALL check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 357')
     316
     317  DO iq=1,nqtot
     318    tr => tracers(iq)
     319!    write(*,*) 'vlspltgen 349: iq=',iq
     320    IF(tr%igen /= 1) CYCLE
     321#ifdef DEBUG_IO   
     322    CALL WriteField_u('zq',zq(:,:,iq))
     323    CALL WriteField_u('zm',zm(:,:,iq))
     324#endif
     325    !----------------------------------------------------------------------
     326    SELECT CASE(iadv(iq))
     327    !----------------------------------------------------------------------
     328      CASE(0); CYCLE
     329    !----------------------------------------------------------------------
     330      CASE(10,14)
     331!$OMP BARRIER       
     332#ifdef _ADV_HALLO
     333        CALL vlz_loc(zq,pente_max,zm,mw,ij_begin,ij_begin+2*iip1-1,iq)
     334        CALL vlz_loc(zq,pente_max,zm,mw,ij_end-2*iip1+1,ij_end,iq)
     335#else
     336        CALL vlz_loc(zq,pente_max,zm,mw,ij_begin,ij_end,iq)
     337#endif
     338!$OMP BARRIER
     339!$OMP MASTER
     340        CALL VTb(VTHallo)
     341!$OMP END MASTER
     342        CALL Register_Hallo_u(zq(:,:,iq),llm,2,2,2,2,MyRequest2)
     343        CALL Register_Hallo_u(zm(:,:,iq),llm,1,1,1,1,MyRequest2)
     344        ! CRisi
     345        DO ichld=1,tr%ndesc
     346          iq2=tr%idesc(ichld)
     347          CALL Register_Hallo_u(zq(:,:,iq2),llm,2,2,2,2,MyRequest2)
     348          CALL Register_Hallo_u(zm(:,:,iq2),llm,1,1,1,1,MyRequest2)
     349        END DO
     350!$OMP MASTER
     351        CALL VTe(VTHallo)
     352!$OMP END MASTER       
     353!$OMP BARRIER
     354    !----------------------------------------------------------------------
     355      CASE DEFAULT; STOP 'vlspltgen_p : schema non parallelise'
     356    !----------------------------------------------------------------------
     357    END SELECT
     358    !----------------------------------------------------------------------
     359  END DO
     360!$OMP BARRIER     
     361
     362
     363!$OMP MASTER       
     364  CALL VTb(VTHallo)
     365!$OMP END MASTER
     366
     367  CALL SendRequest(MyRequest2)
     368
     369!$OMP MASTER
     370  CALL VTe(VTHallo)
     371!$OMP END MASTER       
     372
     373  CALL check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 429')
     374
     375!$OMP BARRIER
     376  DO iq=1,nqtot
     377    tr => tracers(iq)
     378!    write(*,*) 'vlspltgen 409: iq=',iq
     379    IF(tr%igen /= 1) CYCLE
     380    !----------------------------------------------------------------------
     381    SELECT CASE(iadv(iq))
     382    !----------------------------------------------------------------------
     383      CASE(0); CYCLE
     384    !----------------------------------------------------------------------
     385      CASE(10,14)
     386!$OMP BARRIER       
     387#ifdef _ADV_HALLO
     388        CALL vlz_loc(zq,pente_max,zm,mw,ij_begin+2*iip1,ij_end-2*iip1,iq)
     389#endif
     390!$OMP BARRIER
     391    !----------------------------------------------------------------------
     392      CASE DEFAULT; STOP 'vlspltgen_p : schema non parallelise'
     393    !----------------------------------------------------------------------
     394    END SELECT
     395    !----------------------------------------------------------------------
     396  END DO
     397!  write(*,*) 'vlspltgen_loc 476'
     398
     399!$OMP BARRIER
     400!  write(*,*) 'vlspltgen_loc 477'
     401!$OMP MASTER
     402  CALL VTb(VTHallo)
     403!$OMP END MASTER
     404
     405!  CALL WaitRecvRequest(MyRequest2)
     406!  CALL WaitSendRequest(MyRequest2)
     407!$OMP BARRIER
     408  CALL WaitRequest(MyRequest2)
     409
     410!$OMP MASTER
     411  CALL VTe(VTHallo)
     412!$OMP END MASTER
     413!$OMP BARRIER
     414
     415!  write(*,*) 'vlspltgen_loc 494'
     416  CALL check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 461')
     417
     418  DO iq=1,nqtot
     419    tr => tracers(iq)
     420!    write(*,*) 'vlspltgen 449: iq=',iq
     421    IF(tr%igen /= 1) CYCLE
     422#ifdef DEBUG_IO   
     423      CALL WriteField_u('zq',zq(:,:,iq))
     424      CALL WriteField_u('zm',zm(:,:,iq))
     425#endif
     426    !----------------------------------------------------------------------
     427    SELECT CASE(iadv(iq))
     428      CASE(0); CYCLE
     429      CASE(10); CALL   vly_loc(zq,pente_max,zm,mv,iq)
     430      CASE(14); CALL vlyqs_loc(zq,pente_max,zm,mv,qsat,iq)
     431      CASE DEFAULT; STOP 'vlspltgen_p : schema non parallelise'
     432    END SELECT
     433    !----------------------------------------------------------------------
     434  END DO
     435
     436  CALL check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 493')
     437
     438  DO iq=1,nqtot
     439    tr => tracers(iq)
     440!    write(*,*) 'vlspltgen 477: iq=',iq
     441    IF(tr%igen /= 1) CYCLE
     442#ifdef DEBUG_IO   
     443    CALL WriteField_u('zq',zq(:,:,iq))
     444    CALL WriteField_u('zm',zm(:,:,iq))
     445#endif
     446    !----------------------------------------------------------------------
     447    SELECT CASE(iadv(iq))
     448      CASE(0); CYCLE
     449      CASE(10); CALL   vlx_loc(zq,pente_max,zm,mu,     ij_begin,ij_end,iq)
     450      CASE(14); CALL vlxqs_loc(zq,pente_max,zm,mu,qsat,ij_begin,ij_end,iq)
     451      CASE DEFAULT; STOP 'vlspltgen_p : schema non parallelise'
     452    END SELECT
     453    !----------------------------------------------------------------------
     454  END DO
     455
     456!  write(*,*) 'vlspltgen 550: apres derniere serie de call vlx'
     457  CALL check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 521')
     458 
     459  ijb=ij_begin
     460  ije=ij_end
     461!  write(*,*) 'vlspltgen_loc 557'
     462!$OMP BARRIER     
     463
     464!  write(*,*) 'vlspltgen_loc 559' 
     465  DO iq=1,nqtot
     466  !  write(*,*) 'vlspltgen_loc 561, iq=',iq 
     467#ifdef DEBUG_IO   
     468    CALL WriteField_u('zq',zq(:,:,iq))
     469    CALL WriteField_u('zm',zm(:,:,iq))
     470#endif
     471!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)         
     472    DO l=1,llm
     473      DO ij=ijb,ije
     474!         print *,'zq-->',ij,l,iq,zq(ij,l,iq)
     475!         print *,'q-->',ij,l,iq,q(ij,l,iq)
     476        q(ij,l,iq)=zq(ij,l,iq)
     477      END DO
     478    END DO
     479!$OMP END DO NOWAIT   
     480  !  write(*,*) 'vlspltgen_loc 575'     
     481
     482!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     483    DO l=1,llm
     484      DO ij=ijb,ije-iip1+1,iip1
     485         q(ij+iim,l,iq)=q(ij,l,iq)
     486      END DO
     487    END DO
     488!$OMP END DO NOWAIT 
     489!  write(*,*) 'vlspltgen_loc 583' 
     490  END DO
    99491       
    100         ijb=ij_begin-iip1
    101         ije=ij_end+iip1
    102         if (pole_nord) ijb=ij_begin
    103         if (pole_sud) ije=ij_end
    104        
    105 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    106         DO l = 1, llm
    107          DO ij = ijb, ije
    108           tempe(ij) = teta(ij,l) * pk(ij,l) /cpp
    109          ENDDO
    110          DO ij = ijb, ije
    111           zdelta = MAX( 0., SIGN(1., rtt - tempe(ij)) )
    112           play   = 0.5*(p(ij,l)+p(ij,l+1))
    113           qsat(ij,l) = MIN(0.5, r2es* FOEEW(tempe(ij),zdelta) / play )
    114           qsat(ij,l) = qsat(ij,l) / ( 1. - retv * qsat(ij,l) )
    115          ENDDO
    116         ENDDO
    117 c$OMP END DO NOWAIT
    118 c      PRINT*,'Debut vlsplt version debug sans vlyqs'
    119 
    120         zzpbar = 0.5 * pdt
    121         zzw    = pdt
    122 
    123       ijb=ij_begin
    124       ije=ij_end
    125       if (pole_nord) ijb=ijb+iip1
    126       if (pole_sud)  ije=ije-iip1
    127 
    128 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
    129       DO l=1,llm
    130         DO ij = ijb,ije
    131             mu(ij,l)=pbaru(ij,l) * zzpbar
    132          ENDDO
    133       ENDDO
    134 c$OMP END DO NOWAIT
    135      
    136       ijb=ij_begin-iip1
    137       ije=ij_end
    138       if (pole_nord) ijb=ij_begin
    139       if (pole_sud)  ije=ij_end-iip1
    140 
    141 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    142       DO l=1,llm
    143          DO ij=ijb,ije
    144             mv(ij,l)=pbarv(ij,l) * zzpbar
    145          ENDDO
    146       ENDDO
    147 c$OMP END DO NOWAIT
    148 
    149       ijb=ij_begin
    150       ije=ij_end
    151 
    152       DO iq=1,nqtot
    153 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    154       DO l=1,llm
    155          DO ij=ijb,ije
    156             mw(ij,l,iq)=w(ij,l) * zzw
    157          ENDDO
    158       ENDDO
    159 c$OMP END DO NOWAIT
    160       ENDDO
    161 
    162       DO iq=1,nqtot 
    163 c$OMP MASTER
    164       DO ij=ijb,ije
    165          mw(ij,llm+1,iq)=0.
    166       ENDDO
    167 c$OMP END MASTER
    168       ENDDO
    169 
    170 c      CALL SCOPY(ijp1llm,q,1,zq,1)
    171 c      CALL SCOPY(ijp1llm,masse,1,zm,1)
    172 
    173        ijb=ij_begin
    174        ije=ij_end
    175 
    176       DO iq=1,nqtot       
    177 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    178         DO l=1,llm
    179           zq(ijb:ije,l,iq)=q(ijb:ije,l,iq)
    180           zm(ijb:ije,l,iq)=masse(ijb:ije,l)
    181         ENDDO
    182 c$OMP END DO NOWAIT
    183       ENDDO
    184 
    185 #ifdef DEBUG_IO     
    186        CALL WriteField_u('mu',mu)
    187        CALL WriteField_v('mv',mv)
    188        CALL WriteField_u('mw',mw)
    189        CALL WriteField_u('qsat',qsat)
    190 #endif
    191 
    192       ! verif temporaire
    193       ijb=ij_begin
    194       ije=ij_end 
    195       if (ok_iso_verif) then
    196         call check_isotopes(zq,ijb,ije,'vlspltgen_loc 191')
    197       endif !if (ok_iso_verif) then   
    198 
    199 c$OMP BARRIER           
    200 !      DO iq=1,nqtot
    201       DO iq=1,nqperes ! CRisi: on ne boucle que sur les pères= ceux qui sont transportés directement par l'air
    202        !write(*,*) 'vlspltgen 192: iq,iadv=',iq,iadv(iq)
    203 #ifdef DEBUG_IO   
    204        CALL WriteField_u('zq',zq(:,:,iq))
    205        CALL WriteField_u('zm',zm(:,:,iq))
    206 #endif
    207         if(iadv(iq) == 0) then
    208        
    209           cycle
    210        
    211         else if (iadv(iq)==10) then
    212 
    213 #ifdef _ADV_HALO       
    214 ! CRisi: on ajoute les nombres de fils et tableaux des fils
    215 ! On suppose qu'on ne peut advecter les fils que par le schéma 10. 
    216           call vlx_loc(zq,pente_max,zm,mu,
    217      &                     ij_begin,ij_begin+2*iip1-1,iq)
    218           call vlx_loc(zq,pente_max,zm,mu,
    219      &               ij_end-2*iip1+1,ij_end,iq)
    220 #else
    221           call vlx_loc(zq,pente_max,zm,mu,
    222      &                     ij_begin,ij_end,iq)
    223 #endif
    224 
    225 c$OMP MASTER
    226           call VTb(VTHallo)
    227 c$OMP END MASTER
    228           call Register_Hallo_u(zq(:,:,iq),llm,2,2,2,2,MyRequest1)
    229           call Register_Hallo_u(zm(:,:,iq),llm,1,1,1,1,MyRequest1)
    230 ! CRisi
    231           do ifils=1,nqdesc(iq)
    232             iq2=iqfils(ifils,iq)
    233             call Register_Hallo_u(zq(:,:,iq2),llm,2,2,2,2,MyRequest1)
    234             call Register_Hallo_u(zm(:,:,iq2),llm,1,1,1,1,MyRequest1)
    235           enddo
    236 
    237 c$OMP MASTER
    238           call VTe(VTHallo)
    239 c$OMP END MASTER
    240         else if (iadv(iq)==14) then
    241 
    242 #ifdef _ADV_HALO           
    243           call vlxqs_loc(zq,pente_max,zm,mu,
    244      &                   qsat,ij_begin,ij_begin+2*iip1-1,iq)
    245           call vlxqs_loc(zq,pente_max,zm,mu,
    246      &                   qsat,ij_end-2*iip1+1,ij_end,iq)
    247 #else
    248           call vlxqs_loc(zq,pente_max,zm,mu,
    249      &                   qsat,ij_begin,ij_end,iq)
    250 #endif
    251 
    252 c$OMP MASTER
    253           call VTb(VTHallo)
    254 c$OMP END MASTER
    255 
    256           call Register_Hallo_u(zq(:,:,iq),llm,2,2,2,2,MyRequest1)
    257           call Register_Hallo_u(zm(:,:,iq),llm,1,1,1,1,MyRequest1)
    258           do ifils=1,nqdesc(iq)
    259             iq2=iqfils(ifils,iq)
    260             call Register_Hallo_u(zq(:,:,iq2),llm,2,2,2,2,MyRequest1)
    261             call Register_Hallo_u(zm(:,:,iq2),llm,1,1,1,1,MyRequest1)
    262           enddo
    263 
    264 c$OMP MASTER
    265           call VTe(VTHallo)
    266 c$OMP END MASTER
    267         else
    268        
    269           stop 'vlspltgen_p : schema non parallelise'
    270      
    271         endif
    272      
    273       enddo !DO iq=1,nqperes
    274      
    275      
    276 c$OMP BARRIER     
    277 c$OMP MASTER     
    278       call VTb(VTHallo)
    279 c$OMP END MASTER
    280 
    281       call SendRequest(MyRequest1)
    282 
    283 c$OMP MASTER
    284       call VTe(VTHallo)
    285 c$OMP END MASTER       
    286 c$OMP BARRIER
    287 
    288       ! verif temporaire
    289       ijb=ij_begin-2*iip1
    290       ije=ij_end+2*iip1 
    291       if (pole_nord) ijb=ij_begin
    292       if (pole_sud)  ije=ij_end 
    293       if (ok_iso_verif) then
    294            call check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 280')
    295       endif !if (ok_iso_verif) then
    296 
    297       do iq=1,nqperes
    298         !write(*,*) 'vlspltgen 279: iq=',iq
    299 
    300         if(iadv(iq) == 0) then
    301        
    302           cycle
    303        
    304         else if (iadv(iq)==10) then
    305 
    306 #ifdef _ADV_HALLO
    307           call vlx_loc(zq,pente_max,zm,mu,
    308      &                 ij_begin+2*iip1,ij_end-2*iip1,iq)
    309 #endif       
    310         else if (iadv(iq)==14) then
    311 #ifdef _ADV_HALLO
    312           call vlxqs_loc(zq,pente_max,zm,mu,
    313      &                    qsat,ij_begin+2*iip1,ij_end-2*iip1,iq)
    314 #endif   
    315         else
    316        
    317           stop 'vlspltgen_p : schema non parallelise'
    318      
    319         endif
    320      
    321       enddo
    322 c$OMP BARRIER     
    323 c$OMP MASTER
    324       call VTb(VTHallo)
    325 c$OMP END MASTER
    326 
    327 !      call WaitRecvRequest(MyRequest1)
    328 !      call WaitSendRequest(MyRequest1)
    329 c$OMP BARRIER
    330        call WaitRequest(MyRequest1)
    331 
    332 
    333 c$OMP MASTER
    334       call VTe(VTHallo)
    335 c$OMP END MASTER
    336 c$OMP BARRIER
    337 
    338      
    339       if (ok_iso_verif) then
    340            call check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 326')
    341       endif !if (ok_iso_verif) then       
    342       if (ok_iso_verif) then
    343            ijb=ij_begin-2*iip1
    344            ije=ij_end+2*iip1
    345            if (pole_nord) ijb=ij_begin
    346            if (pole_sud)  ije=ij_end
    347            call check_isotopes(zq,ijb,ije,'vlspltgen_loc 336')
    348       endif !if (ok_iso_verif) then 
    349 
    350       do iq=1,nqperes
    351        !write(*,*) 'vlspltgen 321: iq=',iq
    352 #ifdef DEBUG_IO   
    353        CALL WriteField_u('zq',zq(:,:,iq))
    354        CALL WriteField_u('zm',zm(:,:,iq))
    355 #endif
    356 
    357         if(iadv(iq) == 0) then
    358        
    359           cycle
    360        
    361         else if (iadv(iq)==10) then
    362        
    363           call vly_loc(zq,pente_max,zm,mv,iq)
    364  
    365         else if (iadv(iq)==14) then
    366      
    367           call vlyqs_loc(zq,pente_max,zm,mv,
    368      &                   qsat,iq)
    369  
    370         else
    371        
    372           stop 'vlspltgen_p : schema non parallelise'
    373      
    374         endif
    375        
    376        enddo
    377 
    378       if (ok_iso_verif) then
    379            call check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 357')
    380       endif !if (ok_iso_verif) then
    381 
    382       do iq=1,nqperes
    383       !write(*,*) 'vlspltgen 349: iq=',iq
    384 #ifdef DEBUG_IO   
    385        CALL WriteField_u('zq',zq(:,:,iq))
    386        CALL WriteField_u('zm',zm(:,:,iq))
    387 #endif
    388         if(iadv(iq) == 0) then
    389          
    390           cycle
    391        
    392         else if (iadv(iq)==10 .or. iadv(iq)==14 ) then
    393 
    394 c$OMP BARRIER       
    395 #ifdef _ADV_HALLO
    396           call vlz_loc(zq,pente_max,zm,mw,
    397      &               ij_begin,ij_begin+2*iip1-1,iq)
    398           call vlz_loc(zq,pente_max,zm,mw,
    399      &               ij_end-2*iip1+1,ij_end,iq)
    400 #else
    401           call vlz_loc(zq,pente_max,zm,mw,
    402      &               ij_begin,ij_end,iq)
    403 #endif
    404 c$OMP BARRIER
    405 
    406 c$OMP MASTER
    407           call VTb(VTHallo)
    408 c$OMP END MASTER
    409 
    410           call Register_Hallo_u(zq(:,:,iq),llm,2,2,2,2,MyRequest2)
    411           call Register_Hallo_u(zm(:,:,iq),llm,1,1,1,1,MyRequest2)
    412           ! CRisi
    413           do ifils=1,nqdesc(iq)
    414             iq2=iqfils(ifils,iq)
    415             call Register_Hallo_u(zq(:,:,iq2),llm,2,2,2,2,MyRequest2)
    416             call Register_Hallo_u(zm(:,:,iq2),llm,1,1,1,1,MyRequest2)
    417           enddo     
    418 c$OMP MASTER
    419           call VTe(VTHallo)
    420 c$OMP END MASTER       
    421 c$OMP BARRIER
    422         else
    423        
    424           stop 'vlspltgen_p : schema non parallelise'
    425      
    426         endif
    427      
    428       enddo
    429 c$OMP BARRIER     
    430 
    431 c$OMP MASTER       
    432       call VTb(VTHallo)
    433 c$OMP END MASTER
    434 
    435       call SendRequest(MyRequest2)
    436 
    437 c$OMP MASTER
    438       call VTe(VTHallo)
    439 c$OMP END MASTER       
    440 
    441 
    442       if (ok_iso_verif) then
    443            call check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 429')
    444       endif !if (ok_iso_verif) then
    445 
    446 c$OMP BARRIER
    447       do iq=1,nqperes
    448       !write(*,*) 'vlspltgen 409: iq=',iq
    449 
    450         if(iadv(iq) == 0) then
    451          
    452           cycle
    453        
    454         else if (iadv(iq)==10 .or. iadv(iq)==14 ) then
    455 c$OMP BARRIER       
    456 
    457 #ifdef _ADV_HALLO
    458           call vlz_loc(zq,pente_max,zm,mw,
    459      &               ij_begin+2*iip1,ij_end-2*iip1,iq)
    460 #endif
    461 
    462 c$OMP BARRIER       
    463         else
    464        
    465           stop 'vlspltgen_p : schema non parallelise'
    466      
    467         endif
    468      
    469       enddo
    470       !write(*,*) 'vlspltgen_loc 476'
    471 
    472 c$OMP BARRIER
    473       !write(*,*) 'vlspltgen_loc 477'
    474 c$OMP MASTER
    475       call VTb(VTHallo)
    476 c$OMP END MASTER
    477 
    478 !      call WaitRecvRequest(MyRequest2)
     492  CALL check_isotopes(q,ij_begin,ij_end,'vlspltgen_loc 557')
     493
     494!$OMP BARRIER
     495
     496!!$OMP MASTER     
     497!      call WaitSendRequest(MyRequest1)
    479498!      call WaitSendRequest(MyRequest2)
    480 c$OMP BARRIER
    481        CALL WaitRequest(MyRequest2)
    482 
    483 c$OMP MASTER
    484       call VTe(VTHallo)
    485 c$OMP END MASTER
    486 c$OMP BARRIER
    487 
    488 
    489       !write(*,*) 'vlspltgen_loc 494'
    490       if (ok_iso_verif) then
    491            call check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 461')
    492       endif !if (ok_iso_verif) then
    493 
    494       do iq=1,nqperes
    495       !write(*,*) 'vlspltgen 449: iq=',iq
    496 #ifdef DEBUG_IO   
    497        CALL WriteField_u('zq',zq(:,:,iq))
    498        CALL WriteField_u('zm',zm(:,:,iq))
    499 #endif
    500         if(iadv(iq) == 0) then
    501        
    502           cycle
    503        
    504         else if (iadv(iq)==10) then
    505        
    506           call vly_loc(zq,pente_max,zm,mv,iq)
    507  
    508         else if (iadv(iq)==14) then
    509      
    510           call vlyqs_loc(zq,pente_max,zm,mv,
    511      &                   qsat,iq)
    512  
    513         else
    514        
    515           stop 'vlspltgen_p : schema non parallelise'
    516      
    517         endif
    518        
    519        enddo !do iq=1,nqperes
    520 
    521       if (ok_iso_verif) then
    522            call check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 493')
    523       endif !if (ok_iso_verif) then
    524 
    525       do iq=1,nqperes
    526       !write(*,*) 'vlspltgen 477: iq=',iq
    527 #ifdef DEBUG_IO   
    528        CALL WriteField_u('zq',zq(:,:,iq))
    529        CALL WriteField_u('zm',zm(:,:,iq))
    530 #endif
    531         if(iadv(iq) == 0) then
    532          
    533           cycle
    534        
    535         else if (iadv(iq)==10) then
    536        
    537           call vlx_loc(zq,pente_max,zm,mu,
    538      &               ij_begin,ij_end,iq)
    539  
    540         else if (iadv(iq)==14) then
    541      
    542           call vlxqs_loc(zq,pente_max,zm,mu,
    543      &                 qsat, ij_begin,ij_end,iq)
    544  
    545         else
    546        
    547           stop 'vlspltgen_p : schema non parallelise'
    548      
    549         endif
    550        
    551        enddo !do iq=1,nqperes
    552 
    553       !write(*,*) 'vlspltgen 550: apres derniere serie de call vlx'
    554       if (ok_iso_verif) then
    555            call check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 521')
    556       endif !if (ok_iso_verif) then
    557      
    558       ijb=ij_begin
    559       ije=ij_end
    560       !write(*,*) 'vlspltgen_loc 557'
    561 c$OMP BARRIER     
    562 
    563       !write(*,*) 'vlspltgen_loc 559' 
    564       DO iq=1,nqtot
    565        !write(*,*) 'vlspltgen_loc 561, iq=',iq 
    566 #ifdef DEBUG_IO   
    567        CALL WriteField_u('zq',zq(:,:,iq))
    568        CALL WriteField_u('zm',zm(:,:,iq))
    569 #endif
    570 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)         
    571         DO l=1,llm
    572            DO ij=ijb,ije
    573 c             print *,'zq-->',ij,l,iq,zq(ij,l,iq)
    574 c             print *,'q-->',ij,l,iq,q(ij,l,iq)
    575              q(ij,l,iq)=zq(ij,l,iq)
    576            ENDDO
    577         ENDDO
    578 c$OMP END DO NOWAIT   
    579       !write(*,*) 'vlspltgen_loc 575'     
    580 
    581 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    582         DO l=1,llm
    583            DO ij=ijb,ije-iip1+1,iip1
    584               q(ij+iim,l,iq)=q(ij,l,iq)
    585            ENDDO
    586         ENDDO
    587 c$OMP END DO NOWAIT 
    588       !write(*,*) 'vlspltgen_loc 583' 
    589       ENDDO !DO iq=1,nqtot
    590        
    591       if (ok_iso_verif) then
    592            call check_isotopes(q,ij_begin,ij_end,'vlspltgen_loc 557')
    593       endif !if (ok_iso_verif) then
    594 
    595 c$OMP BARRIER
    596 
    597 cc$OMP MASTER     
    598 c      call WaitSendRequest(MyRequest1)
    599 c      call WaitSendRequest(MyRequest2)
    600 cc$OMP END MASTER
    601 cc$OMP BARRIER
    602 
    603       !write(*,*) 'vlspltgen 597: sortie' 
    604       RETURN
    605       END
     499!!$OMP END MASTER
     500!!$OMP BARRIER
     501
     502!  write(*,*) 'vlspltgen 597: sortie' 
     503
     504END
Note: See TracChangeset for help on using the changeset viewer.