Ignore:
Timestamp:
Apr 9, 2009, 12:11:35 PM (16 years ago)
Author:
Laurent Fairhead
Message:

Réintegration dans le tronc des modifications issues de la branche LMDZ-dev
comprises entre la révision 1074 et 1145
Validation: une simulation de 1 jour en séquentiel sur PC donne les mêmes
résultats entre la trunk et la dev
LF

Location:
LMDZ4/trunk
Files:
5 deleted
37 edited
3 copied

Legend:

Unmodified
Added
Removed

  • LMDZ4/trunk

  • LMDZ4/trunk/libf/dyn3dpar/addfi_p.F

    r774 r1146  
    22! $Header$
    33!
    4       SUBROUTINE addfi_p(nq, pdt, leapf, forward,
     4      SUBROUTINE addfi_p(pdt, leapf, forward,
    55     S          pucov, pvcov, pteta, pq   , pps ,
    66     S          pdufi, pdvfi, pdhfi,pdqfi, pdpfi  )
    77      USE parallel
     8      USE infotrac, ONLY : nqtot
    89      IMPLICIT NONE
    910c
    … …  
    5354c    -----------
    5455c
    55       INTEGER nq
    56 
    5756      REAL pdt
    5857c
    5958      REAL pvcov(ip1jm,llm),pucov(ip1jmp1,llm)
    60       REAL pteta(ip1jmp1,llm),pq(ip1jmp1,llm,nq),pps(ip1jmp1)
     59      REAL pteta(ip1jmp1,llm),pq(ip1jmp1,llm,nqtot),pps(ip1jmp1)
    6160c
    6261      REAL pdvfi(ip1jm,llm),pdufi(ip1jmp1,llm)
    63       REAL pdqfi(ip1jmp1,llm,nq),pdhfi(ip1jmp1,llm),pdpfi(ip1jmp1)
     62      REAL pdqfi(ip1jmp1,llm,nqtot),pdhfi(ip1jmp1,llm),pdpfi(ip1jmp1)
    6463c
    6564      LOGICAL leapf,forward
    … …  
    166165      ENDDO
    167166
    168       DO iq = 3, nq
     167      DO iq = 3, nqtot
    169168c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    170169         DO k = 1,llm
    … …  
    208207
    209208      if (pole_nord) then
    210         DO iq = 1, nq
     209        DO iq = 1, nqtot
    211210c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    212211          DO  k    = 1, llm
    … …  
    225224     
    226225      if (pole_sud) then
    227         DO iq = 1, nq
     226        DO iq = 1, nqtot
    228227c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    229228          DO  k    = 1, llm

  • LMDZ4/trunk/libf/dyn3dpar/advtrac_p.F

    r985 r1146  
    2222      USE Vampir
    2323      USE times
     24      USE infotrac
    2425      IMPLICIT NONE
    2526c
    … …  
    3536#include "ener.h"
    3637#include "description.h"
    37 #include "advtrac.h"
    3838
    3939c-------------------------------------------------------------------
    … …  
    4646      INTEGER iapptrac
    4747      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
    48       REAL q(ip1jmp1,llm,nqmx),masse(ip1jmp1,llm)
     48      REAL q(ip1jmp1,llm,nqtot),masse(ip1jmp1,llm)
    4949      REAL p( ip1jmp1,llmp1 ),teta(ip1jmp1,llm)
    5050      REAL pk(ip1jmp1,llm)
    … …  
    5959      REAL,SAVE::pbarug(ip1jmp1,llm),pbarvg(ip1jm,llm),wg(ip1jmp1,llm)
    6060      REAL (kind=kind(1.d0)) :: t_initial, t_final, tps_cpu
    61       real cpuadv(nqmx)
    62       common/cpuadv/cpuadv
    63 
    6461      INTEGER iadvtr
    6562      INTEGER ij,l,iq,iiq
    … …  
    7673      REAL psppm(iim,jjp1) ! pression  au sol
    7774      REAL unatppm(iim,jjp1,llm),vnatppm(iim,jjp1,llm)
    78       REAL qppm(iim*jjp1,llm,nqmx)
     75      REAL qppm(iim*jjp1,llm,nqtot)
    7976      REAL fluxwppm(iim,jjp1,llm)
    8077      REAL apppm(llmp1), bpppm(llmp1)
    … …  
    8885      REAL,SAVE :: teta_tmp(ip1jmp1,llm)
    8986      REAL,SAVE :: pk_tmp(ip1jmp1,llm)
    90      
     87
    9188      ijb_u=ij_begin
    9289      ije_u=ij_end
    … …  
    196193      call Register_SwapFieldHallo(pk_tmp,pk_tmp,ip1jmp1,llm,
    197194     *                             jj_Nb_vanleer,1,1,Request_vanleer)
    198       do j=1,nqmx
     195      do j=1,nqtot
    199196        call Register_SwapFieldHallo(q(1,1,j),q(1,1,j),ip1jmp1,llm,
    200197     *                             jj_nb_vanleer,0,0,Request_vanleer)
    … …  
    279276c     Appel des sous programmes d'advection
    280277c-----------------------------------------------------------
    281       do iq=1,nqmx
     278      do iq=1,nqtot
    282279c        call clock(t_initial)
    283280        if(iadv(iq) == 0) cycle
    … …  
    479476c$OMP END MASTER
    480477
    481         do j=1,nqmx
     478        do j=1,nqtot
    482479          call Register_SwapFieldHallo(q(1,1,j),q(1,1,j),ip1jmp1,llm,
    483480     *                             jj_nb_caldyn,0,0,Request_vanleer)

  • LMDZ4/trunk/libf/dyn3dpar/caladvtrac_p.F

    r960 r1146  
    88     *                   flxw, pk, iapptrac)
    99      USE parallel
     10      USE infotrac
    1011c
    1112      IMPLICIT NONE
    … …  
    2526#include "comconst.h"
    2627#include "control.h"
    27 #include "advtrac.h"
    2828
    2929c   Arguments:
    3030c   ----------
    3131      REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm),masse(ip1jmp1,llm)
    32       REAL p( ip1jmp1,llmp1),q( ip1jmp1,llm,nqmx),dq( ip1jmp1,llm,2 )
     32      REAL p( ip1jmp1,llmp1),q( ip1jmp1,llm,nqtot),dq( ip1jmp1,llm,2 )
    3333      REAL teta( ip1jmp1,llm),pk( ip1jmp1,llm)
    3434      REAL               :: flxw(ip1jmp1,llm)
    … …  
    4848      REAL finmasse(ip1jmp1,llm), dtvrtrac
    4949     
    50 
    5150cc
    5251c

  • LMDZ4/trunk/libf/dyn3dpar/calfis_p.F

    r1000 r1146  
    44C
    55C
    6       SUBROUTINE calfis_p(nq,
    7      $                  lafin,
     6      SUBROUTINE calfis_p(lafin,
    87     $                  rdayvrai,
    98     $                  heure,
    … …  
    4039      USE Times
    4140      USE IOPHY
     41      USE infotrac
     42
    4243      IMPLICIT NONE
    4344c=======================================================================
    … …  
    9899#include "paramet.h"
    99100#include "temps.h"
    100 #include "advtrac.h"
    101 
    102       INTEGER ngridmx,nq
     101
     102      INTEGER ngridmx
    103103      PARAMETER( ngridmx = 2+(jjm-1)*iim - 1/jjm   )
    104104
    … …  
    119119      REAL pteta(iip1,jjp1,llm)
    120120      REAL pmasse(iip1,jjp1,llm)
    121       REAL pq(iip1,jjp1,llm,nqmx)
     121      REAL pq(iip1,jjp1,llm,nqtot)
    122122      REAL pphis(iip1,jjp1)
    123123      REAL pphi(iip1,jjp1,llm)
    … …  
    126126      REAL pducov(iip1,jjp1,llm)
    127127      REAL pdteta(iip1,jjp1,llm)
    128       REAL pdq(iip1,jjp1,llm,nqmx)
     128      REAL pdq(iip1,jjp1,llm,nqtot)
    129129c
    130130      REAL pps(iip1,jjp1)
    … …  
    135135      REAL pdufi(iip1,jjp1,llm)
    136136      REAL pdhfi(iip1,jjp1,llm)
    137       REAL pdqfi(iip1,jjp1,llm,nqmx)
     137      REAL pdqfi(iip1,jjp1,llm,nqtot)
    138138      REAL pdpsfi(iip1,jjp1)
    139139
    … …  
    253253      ALLOCATE(zphi(klon,llm),zphis(klon))
    254254      ALLOCATE(zufi(klon,llm), zvfi(klon,llm))
    255       ALLOCATE(ztfi(klon,llm),zqfi(klon,llm,nqmx))
     255      ALLOCATE(ztfi(klon,llm),zqfi(klon,llm,nqtot))
    256256      ALLOCATE(pcvgu(klon,llm), pcvgv(klon,llm))
    257257      ALLOCATE(pcvgt(klon,llm), pcvgq(klon,llm,2))
    258258c      ALLOCATE(pvervel(klon,llm))
    259259      ALLOCATE(zdufi(klon,llm),zdvfi(klon,llm))
    260       ALLOCATE(zdtfi(klon,llm),zdqfi(klon,llm,nqmx))
     260      ALLOCATE(zdtfi(klon,llm),zdqfi(klon,llm,nqtot))
    261261      ALLOCATE(zdpsrf(klon))
    262262      ALLOCATE(zdufi2(klon+iim,llm),zdvfi2(klon+iim,llm))
    … …  
    335335c
    336336
    337       DO iq=1,nq
     337      DO iq=1,nqtot
    338338         iiq=niadv(iq)
    339339c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    … …  
    369369      CALL gr_dyn_fi_p(llm,iip1,jjp1,klon,pphi,zphi)
    370370
    371 c$OMP MASTER
    372371      CALL gr_dyn_fi_p(1,iip1,jjp1,klon,pphis,zphis)
    373 c$OMP END MASTER
     372
    374373c$OMP BARRIER
    375374
    … …  
    527526cc$OMP  PARALLEL DEFAULT(NONE)
    528527cc$OMP+ PRIVATE(i,l,offset,iq)
    529 cc$OMP+ SHARED(klon_omp_nb,nq,klon_omp_begin,
     528cc$OMP+ SHARED(klon_omp_nb,nqtot,klon_omp_begin,
    530529cc$OMP+        debut,lafin,rdayvrai,heure,dtphys,zplev,zplay,
    531530cc$OMP+        zphi,zphis,presnivs,clesphy0,zufi,zvfi,ztfi,
    … …  
    549548        allocate(zvfi_omp(klon,llm))
    550549        allocate(ztfi_omp(klon,llm))
    551         allocate(zqfi_omp(klon,llm,nq))
     550        allocate(zqfi_omp(klon,llm,nqtot))
    552551c        allocate(pvervel_omp(klon,llm))
    553552        allocate(zdufi_omp(klon,llm))
    554553        allocate(zdvfi_omp(klon,llm))
    555554        allocate(zdtfi_omp(klon,llm))
    556         allocate(zdqfi_omp(klon,llm,nq))
     555        allocate(zdqfi_omp(klon,llm,nqtot))
    557556        allocate(zdpsrf_omp(klon))
    558557        allocate(flxwfi_omp(klon,llm))
    … …  
    609608      enddo
    610609       
    611       do iq=1,nq
     610      do iq=1,nqtot
    612611        do l=1,llm
    613612          do i=1,klon
    … …  
    641640      enddo
    642641       
    643       do iq=1,nq
     642      do iq=1,nqtot
    644643        do l=1,llm
    645644          do i=1,klon
    … …  
    664663      CALL physiq (klon,
    665664     .             llm,
    666      .             nq,
    667665     .             debut,
    668666     .             lafin,
    … …  
    743741      enddo
    744742       
    745       do iq=1,nq
     743      do iq=1,nqtot
    746744        do l=1,llm
    747745          do i=1,klon
    … …  
    775773      enddo
    776774       
    777       do iq=1,nq
     775      do iq=1,nqtot
    778776        do l=1,llm
    779777          do i=1,klon
    … …  
    896894c  tendance sur la pression :
    897895c  -----------------------------------
    898 c$OMP MASTER
    899896      CALL gr_fi_dyn_p(1,klon,iip1,jjp1,zdpsrf,pdpsfi)
    900 c$OMP END MASTER
    901897c
    902898c   62. enthalpie potentielle
    … …  
    937933c   ---------------------
    938934
    939       DO iq=1,nqmx
     935      DO iq=1,nqtot
    940936c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    941937         DO l=1,llm
    … …  
    976972C
    977973
    978       DO iq=1,nq
     974      DO iq=1,nqtot
    979975         iiq=niadv(iq)
    980976c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)

  • LMDZ4/trunk/libf/dyn3dpar/comdissip.h

    r774 r1146  
    22! $Header$
    33!
    4 c-----------------------------------------------------------------------
    5 c INCLUDE dissip.h
     4!-----------------------------------------------------------------------
     5! INCLUDE comdissip.h
    66
    7       COMMON/comdissip/
    8      $    lstardis,niterdis,coefdis,tetavel,tetatemp,gamdissip
     7      COMMON/comdissip/                                                 &
     8     &    niterdis,coefdis,tetavel,tetatemp,gamdissip
    99
    1010
    11       LOGICAL lstardis
    1211      INTEGER niterdis
    1312
    1413      REAL tetavel,tetatemp,coefdis,gamdissip
    1514
    16 c-----------------------------------------------------------------------
     15!-----------------------------------------------------------------------

  • LMDZ4/trunk/libf/dyn3dpar/comgeom.h

    r774 r1146  
    22! $Header$
    33!
    4 *CDK comgeom
    5       COMMON/comgeom/
    6      1 cu(ip1jmp1),cv(ip1jm),unscu2(ip1jmp1),unscv2(ip1jm),
    7      2 aire(ip1jmp1),airesurg(ip1jmp1),aireu(ip1jmp1),
    8      3 airev(ip1jm),unsaire(ip1jmp1),apoln,apols,
    9      4 unsairez(ip1jm),airuscv2(ip1jm),airvscu2(ip1jm),
    10      5 aireij1(ip1jmp1),aireij2(ip1jmp1),aireij3(ip1jmp1),
    11      6 aireij4(ip1jmp1),alpha1(ip1jmp1),alpha2(ip1jmp1),
    12      7 alpha3(ip1jmp1),alpha4(ip1jmp1),alpha1p2(ip1jmp1),
    13      8 alpha1p4(ip1jmp1),alpha2p3(ip1jmp1),alpha3p4(ip1jmp1),
    14      9 fext(ip1jm),constang(ip1jmp1),rlatu(jjp1),rlatv(jjm),
    15      1 rlonu(iip1),rlonv(iip1),cuvsurcv(ip1jm),cvsurcuv(ip1jm),
    16      1 cvusurcu(ip1jmp1),cusurcvu(ip1jmp1),cuvscvgam1(ip1jm),
    17      2 cuvscvgam2(ip1jm),cvuscugam1(ip1jmp1),
    18      3 cvuscugam2(ip1jmp1),cvscuvgam(ip1jm),cuscvugam(ip1jmp1),
    19      4 unsapolnga1,unsapolnga2,unsapolsga1,unsapolsga2,
    20      5 unsair_gam1(ip1jmp1),unsair_gam2(ip1jmp1),unsairz_gam(ip1jm),
    21      6 aivscu2gam(ip1jm),aiuscv2gam(ip1jm),xprimu(iip1),xprimv(iip1)
     4!CDK comgeom
     5      COMMON/comgeom/                                                   &
     6     & cu(ip1jmp1),cv(ip1jm),unscu2(ip1jmp1),unscv2(ip1jm),             &
     7     & aire(ip1jmp1),airesurg(ip1jmp1),aireu(ip1jmp1),                  &
     8     & airev(ip1jm),unsaire(ip1jmp1),apoln,apols,                       &
     9     & unsairez(ip1jm),airuscv2(ip1jm),airvscu2(ip1jm),                 &
     10     & aireij1(ip1jmp1),aireij2(ip1jmp1),aireij3(ip1jmp1),              &
     11     & aireij4(ip1jmp1),alpha1(ip1jmp1),alpha2(ip1jmp1),                &
     12     & alpha3(ip1jmp1),alpha4(ip1jmp1),alpha1p2(ip1jmp1),               &
     13     & alpha1p4(ip1jmp1),alpha2p3(ip1jmp1),alpha3p4(ip1jmp1),           &
     14     & fext(ip1jm),constang(ip1jmp1),rlatu(jjp1),rlatv(jjm),            &
     15     & rlonu(iip1),rlonv(iip1),cuvsurcv(ip1jm),cvsurcuv(ip1jm),         &
     16     & cvusurcu(ip1jmp1),cusurcvu(ip1jmp1),cuvscvgam1(ip1jm),           &
     17     & cuvscvgam2(ip1jm),cvuscugam1(ip1jmp1),                           &
     18     & cvuscugam2(ip1jmp1),cvscuvgam(ip1jm),cuscvugam(ip1jmp1),         &
     19     & unsapolnga1,unsapolnga2,unsapolsga1,unsapolsga2,                 &
     20     & unsair_gam1(ip1jmp1),unsair_gam2(ip1jmp1),unsairz_gam(ip1jm),    &
     21     & aivscu2gam(ip1jm),aiuscv2gam(ip1jm),xprimu(iip1),xprimv(iip1)
    2222
    23 c
    24         REAL
    25      1 cu,cv,unscu2,unscv2,aire,airesurg,aireu,airev,unsaire,apoln     ,
    26      2 apols,unsairez,airuscv2,airvscu2,aireij1,aireij2,aireij3,aireij4,
    27      3 alpha1,alpha2,alpha3,alpha4,alpha1p2,alpha1p4,alpha2p3,alpha3p4 ,
    28      4 fext,constang,rlatu,rlatv,rlonu,rlonv,cuvscvgam1,cuvscvgam2     ,
    29      5 cvuscugam1,cvuscugam2,cvscuvgam,cuscvugam,unsapolnga1,unsapolnga2
    30      6 ,unsapolsga1,unsapolsga2,unsair_gam1,unsair_gam2,unsairz_gam    ,
    31      7 aivscu2gam ,aiuscv2gam,cuvsurcv,cvsurcuv,cvusurcu,cusurcvu,xprimu
    32      8 , xprimv
    33 c
     23!
     24        REAL                                                            &
     25     & cu,cv,unscu2,unscv2,aire,airesurg,aireu,airev,unsaire,apoln     ,&
     26     & apols,unsairez,airuscv2,airvscu2,aireij1,aireij2,aireij3,aireij4,&
     27     & alpha1,alpha2,alpha3,alpha4,alpha1p2,alpha1p4,alpha2p3,alpha3p4 ,&
     28     & fext,constang,rlatu,rlatv,rlonu,rlonv,cuvscvgam1,cuvscvgam2     ,&
     29     & cvuscugam1,cvuscugam2,cvscuvgam,cuscvugam,unsapolnga1,unsapolnga2&
     30     & ,unsapolsga1,unsapolsga2,unsair_gam1,unsair_gam2,unsairz_gam    ,&
     31     & aivscu2gam ,aiuscv2gam,cuvsurcv,cvsurcuv,cvusurcu,cusurcvu,xprimu&
     32     & , xprimv
     33!

  • LMDZ4/trunk/libf/dyn3dpar/conf_gcm.F

    r1046 r1146  
    66      SUBROUTINE conf_gcm( tapedef, etatinit, clesphy0 )
    77c
     8#ifdef CPP_IOIPSL
    89      use IOIPSL
     10#else
     11! if not using IOIPSL, we still need to use (a local version of) getin
     12      use ioipsl_getincom
     13#endif
    914      use misc_mod
    1015      use mod_filtre_fft, ONLY : use_filtre_fft
    … …  
    109114c  Parametres de controle du run:
    110115c-----------------------------------------------------------------------
     116!Config  Key  = planet_type
     117!Config  Desc = planet type ("earth", "mars", "venus", ...)
     118!Config  Def  = earth
     119!Config  Help = this flag sets the type of atymosphere that is considered
     120      planet_type="earth"
     121      CALL getin('planet_type',planet_type)
    111122
    112123!Config  Key  = dayref
    … …  
    189200       CALL getin('periodav',periodav)
    190201
     202!Config  Key  = output_grads_dyn
     203!Config  Desc = output dynamics diagnostics in 'dyn.dat' file
     204!Config  Def  = n
     205!Config  Help = output dynamics diagnostics in Grads-readable 'dyn.dat' file
     206       output_grads_dyn=.false.
     207       CALL getin('output_grads_dyn',output_grads_dyn)
     208
    191209!Config  Key  = idissip
    192210!Config  Desc = periode de la dissipation
    … …  
    284302c    ...............................................................
    285303
     304!Config  Key  =  read_start
     305!Config  Desc = Initialize model using a 'start.nc' file
     306!Config  Def  = y
     307!Config  Help = y: intialize dynamical fields using a 'start.nc' file
     308!               n: fields are initialized by 'iniacademic' routine
     309       read_start= .true.
     310       CALL getin('read_start',read_start)
     311
    286312!Config  Key  = iflag_phys
    287313!Config  Desc = Avec ls physique
    … …  
    341367c
    342368      IF( ABS(clat - clatt).GE. 0.001 )  THEN
    343         PRINT *,' La valeur de clat passee par run.def est differente de
    344      * celle lue sur le fichier  start '
     369        write(lunout,*)'conf_gcm: La valeur de clat passee par run.def',
     370     &    ' est differente de celle lue sur le fichier  start '
    345371        STOP
    346372      ENDIF
    … …  
    356382
    357383      IF( ABS(grossismx - grossismxx).GE. 0.001 )  THEN
    358         PRINT *,' La valeur de grossismx passee par run.def est differente 
    359      * de celle lue sur le fichier  start '
     384        write(lunout,*)'conf_gcm: La valeur de grossismx passee par ',
     385     &  'run.def est differente de celle lue sur le fichier  start '
    360386        STOP
    361387      ENDIF
    … …  
    370396
    371397      IF( ABS(grossismy - grossismyy).GE. 0.001 )  THEN
    372         PRINT *,' La valeur de grossismy passee par run.def est differen
    373      * te de celle lue sur le fichier  start '
     398        write(lunout,*)'conf_gcm: La valeur de grossismy passee par ',
     399     & 'run.def est differente de celle lue sur le fichier  start '
    374400        STOP
    375401      ENDIF
    376402     
    377403      IF( grossismx.LT.1. )  THEN
    378         PRINT *,' ***  ATTENTION !! grossismx < 1 .   *** '
     404        write(lunout,*)
     405     &       'conf_gcm: ***  ATTENTION !! grossismx < 1 .   *** '
    379406         STOP
    380407      ELSE
    … …  
    384411
    385412      IF( grossismy.LT.1. )  THEN
    386         PRINT *,' ***  ATTENTION !! grossismy < 1 .   *** '
     413        write(lunout,*)
     414     &       'conf_gcm: ***  ATTENTION !! grossismy < 1 .   *** '
    387415         STOP
    388416      ELSE
    … …  
    390418      ENDIF
    391419
    392       PRINT *,' alphax alphay defrun ',alphax,alphay
     420      write(lunout,*)'conf_gcm: alphax alphay',alphax,alphay
    393421c
    394422c    alphax et alphay sont les anciennes formulat. des grossissements
    … …  
    405433
    406434      IF( .NOT.fxyhypb )  THEN
    407            IF( fxyhypbb )     THEN
    408               PRINT *,' ********  PBS DANS  DEFRUN  ******** '
    409               PRINT *,' *** fxyhypb lu sur le fichier start est F ',
    410      *       'alors  qu il est  T  sur  run.def  ***'
     435         IF( fxyhypbb )     THEN
     436            write(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
     437            write(lunout,*)' *** fxyhypb lu sur le fichier start est ',
     438     *       'F alors  qu il est  T  sur  run.def  ***'
    411439              STOP
    412            ENDIF
     440         ENDIF
    413441      ELSE
    414            IF( .NOT.fxyhypbb )   THEN
    415               PRINT *,' ********  PBS DANS  DEFRUN  ******** '
    416               PRINT *,' ***  fxyhypb lu sur le fichier start est T ',
    417      *        'alors  qu il est  F  sur  run.def  ****  '
     442         IF( .NOT.fxyhypbb )   THEN
     443            write(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
     444            write(lunout,*)' ***  fxyhypb lu sur le fichier start est ',
     445     *        'T alors  qu il est  F  sur  run.def  ****  '
    418446              STOP
    419            ENDIF
     447         ENDIF
    420448      ENDIF
    421449c
    … …  
    430458      IF( fxyhypb )  THEN
    431459       IF( ABS(dzoomx - dzoomxx).GE. 0.001 )  THEN
    432         PRINT *,' La valeur de dzoomx passee par run.def est differente
    433      *  de celle lue sur le fichier  start '
     460        write(lunout,*)'conf_gcm: La valeur de dzoomx passee par ',
     461     *  'run.def est differente de celle lue sur le fichier  start '
    434462        STOP
    435463       ENDIF
    … …  
    446474      IF( fxyhypb )  THEN
    447475       IF( ABS(dzoomy - dzoomyy).GE. 0.001 )  THEN
    448         PRINT *,' La valeur de dzoomy passee par run.def est differente
    449      * de celle lue sur le fichier  start '
     476        write(lunout,*)'conf_gcm: La valeur de dzoomy passee par ',
     477     * 'run.def est differente de celle lue sur le fichier  start '
    450478        STOP
    451479       ENDIF
    … …  
    461489      IF( fxyhypb )  THEN
    462490       IF( ABS(taux - tauxx).GE. 0.001 )  THEN
    463         PRINT *,' La valeur de taux passee par run.def est differente
    464      * de celle lue sur le fichier  start '
     491        write(lunout,*)'conf_gcm: La valeur de taux passee par ',
     492     * 'run.def est differente de celle lue sur le fichier  start '
    465493        STOP
    466494       ENDIF
    … …  
    476504      IF( fxyhypb )  THEN
    477505       IF( ABS(tauy - tauyy).GE. 0.001 )  THEN
    478         PRINT *,' La valeur de tauy passee par run.def est differente
    479      * de celle lue sur le fichier  start '
     506        write(lunout,*)'conf_gcm: La valeur de tauy passee par ',
     507     * 'run.def est differente de celle lue sur le fichier  start '
    480508        STOP
    481509       ENDIF
    … …  
    495523
    496524        IF( .NOT.ysinus )  THEN
    497            IF( ysinuss )     THEN
    498               PRINT *,' ********  PBS DANS  DEFRUN  ******** '
    499               PRINT *,' *** ysinus lu sur le fichier start est F ',
    500      *       'alors  qu il est  T  sur  run.def  ***'
     525          IF( ysinuss )     THEN
     526            write(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
     527            write(lunout,*)' *** ysinus lu sur le fichier start est F',
     528     *       ' alors  qu il est  T  sur  run.def  ***'
     529            STOP
     530          ENDIF
     531        ELSE
     532          IF( .NOT.ysinuss )   THEN
     533            write(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
     534            write(lunout,*)' *** ysinus lu sur le fichier start est T',
     535     *        ' alors  qu il est  F  sur  run.def  ****  '
    501536              STOP
    502            ENDIF
    503         ELSE
    504            IF( .NOT.ysinuss )   THEN
    505               PRINT *,' ********  PBS DANS  DEFRUN  ******** '
    506               PRINT *,' ***  ysinus lu sur le fichier start est T ',
    507      *        'alors  qu il est  F  sur  run.def  ****  '
    508               STOP
    509            ENDIF
     537          ENDIF
    510538        ENDIF
    511       ENDIF
     539      ENDIF ! of IF( .NOT.fxyhypb  )
    512540c
    513541!Config  Key  = offline
    … …  
    529557      CALL getin('config_inca',config_inca)
    530558
     559!Config  Key  = ok_dynzon
     560!Config  Desc = calcul et sortie des transports
     561!Config  Def  = n
     562!Config  Help = Permet de mettre en route le calcul des transports
     563!Config         
     564      ok_dynzon = .FALSE.
     565      CALL getin('ok_dynzon',ok_dynzon)
     566
    531567
    532568      write(lunout,*)' #########################################'
    533569      write(lunout,*)' Configuration des parametres du gcm: '
     570      write(lunout,*)' planet_type = ', planet_type
    534571      write(lunout,*)' dayref = ', dayref
    535572      write(lunout,*)' anneeref = ', anneeref
    … …  
    540577      write(lunout,*)' iecri = ', iecri
    541578      write(lunout,*)' periodav = ', periodav
     579      write(lunout,*)' output_grads_dyn = ', output_grads_dyn
    542580      write(lunout,*)' idissip = ', idissip
    543581      write(lunout,*)' lstardis = ', lstardis
    … …  
    550588      write(lunout,*)' coefdis = ', coefdis
    551589      write(lunout,*)' purmats = ', purmats
     590      write(lunout,*)' read_start = ', read_start
    552591      write(lunout,*)' iflag_phys = ', iflag_phys
    553592      write(lunout,*)' clonn = ', clonn
    … …  
    562601      write(lunout,*)' offline = ', offline
    563602      write(lunout,*)' config_inca = ', config_inca
     603      write(lunout,*)' ok_dynzon = ', ok_dynzon
    564604
    565605      RETURN
    … …  
    600640
    601641      IF( grossismx.LT.1. )  THEN
    602         PRINT *,' ***  ATTENTION !! grossismx < 1 .   *** '
     642        write(lunout,*)
     643     &   'conf_gcm: ***  ATTENTION !! grossismx < 1 .   *** '
    603644         STOP
    604645      ELSE
    … …  
    608649
    609650      IF( grossismy.LT.1. )  THEN
    610         PRINT *,' ***  ATTENTION !! grossismy < 1 .   *** '
     651        write(lunout,*)
     652     &  'conf_gcm: ***  ATTENTION !! grossismy < 1 .   *** '
    611653         STOP
    612654      ELSE
    … …  
    614656      ENDIF
    615657
    616       PRINT *,' alphax alphay defrun ',alphax,alphay
     658      write(lunout,*)'conf_gcm: alphax alphay ',alphax,alphay
    617659c
    618660c    alphax et alphay sont les anciennes formulat. des grossissements
    … …  
    685727      CALL getin('config_inca',config_inca)
    686728
     729!Config  Key  = ok_dynzon
     730!Config  Desc = calcul et sortie des transports
     731!Config  Def  = n
     732!Config  Help = Permet de mettre en route le calcul des transports
     733!Config         
     734      ok_dynzon = .FALSE.
     735      CALL getin('ok_dynzon',ok_dynzon)
     736
    687737!Config  Key  = use_filtre_fft
    688738!Config  Desc = flag d'activation des FFT pour le filtre
    … …  
    692742      use_filtre_fft=.FALSE.
    693743      CALL getin('use_filtre_fft',use_filtre_fft)
     744
     745      IF (use_filtre_fft .AND. grossismx /= 1.0) THEN
     746        write(lunout,*)'WARNING !!! '
     747        write(lunout,*)"Le zoom en longitude est incompatible",
     748     &                 " avec l'utilisation du filtre FFT ",
     749     &                 "---> filtre FFT désactivé "
     750       use_filtre_fft=.FALSE.
     751      ENDIF
     752     
     753 
    694754     
    695755!Config  Key  = use_mpi_alloc
    696 !Config  Desc = Utilise un buffer MPI en mémoire globale
     756!Config  Desc = Utilise un buffer MPI en m�moire globale
    697757!Config  Def  = false
    698758!Config  Help = permet d'activer l'utilisation d'un buffer MPI
    699 !Config         en mémoire globale a l'aide de la fonction MPI_ALLOC.
    700 !Config         Cela peut améliorer la bande passante des transferts MPI
     759!Config         en m�moire globale a l'aide de la fonction MPI_ALLOC.
     760!Config         Cela peut am�liorer la bande passante des transferts MPI
    701761!Config         d'un facteur 2 
    702762      use_mpi_alloc=.FALSE.
    … …  
    706766!Config  Desc = taille des blocs openmp
    707767!Config  Def  = 1
    708 !Config  Help = defini la taille des packets d'itération openmp
    709 !Config         distribuée à chaque tâche lors de l'entrée dans une
    710 !Config         boucle parallélisée
     768!Config  Help = defini la taille des packets d'it�ration openmp
     769!Config         distribu�e � chaque t�che lors de l'entr�e dans une
     770!Config         boucle parall�lis�e
    711771 
    712772      omp_chunk=1
    … …  
    716776!Config  Desc = activation de la version strato
    717777!Config  Def  = .FALSE.
    718 !Config  Help = active la version stratosphérique de LMDZ de F. Lott
     778!Config  Help = active la version stratosph�rique de LMDZ de F. Lott
    719779
    720780      ok_strato=.FALSE.
    … …  
    731791      write(lunout,*)' #########################################'
    732792      write(lunout,*)' Configuration des parametres du gcm: '
     793      write(lunout,*)' planet_type = ', planet_type
    733794      write(lunout,*)' dayref = ', dayref
    734795      write(lunout,*)' anneeref = ', anneeref
    … …  
    739800      write(lunout,*)' iecri = ', iecri
    740801      write(lunout,*)' periodav = ', periodav
     802      write(lunout,*)' output_grads_dyn = ', output_grads_dyn
    741803      write(lunout,*)' idissip = ', idissip
    742804      write(lunout,*)' lstardis = ', lstardis
    … …  
    749811      write(lunout,*)' coefdis = ', coefdis
    750812      write(lunout,*)' purmats = ', purmats
     813      write(lunout,*)' read_start = ', read_start
    751814      write(lunout,*)' iflag_phys = ', iflag_phys
    752815      write(lunout,*)' clon = ', clon
    … …  
    754817      write(lunout,*)' grossismx = ', grossismx
    755818      write(lunout,*)' grossismy = ', grossismy
    756       write(lunout,*)' fxyhypbb = ', fxyhypbb
     819      write(lunout,*)' fxyhypb = ', fxyhypb
    757820      write(lunout,*)' dzoomx = ', dzoomx
    758821      write(lunout,*)' dzoomy = ', dzoomy
    … …  
    761824      write(lunout,*)' offline = ', offline
    762825      write(lunout,*)' config_inca = ', config_inca
     826      write(lunout,*)' ok_dynzon = ', ok_dynzon
    763827      write(lunout,*)' use_filtre_fft = ', use_filtre_fft
    764828      write(lunout,*)' use_mpi_alloc = ', use_mpi_alloc

  • LMDZ4/trunk/libf/dyn3dpar/control.h

    r985 r1146  
    1414     &              iperiod,iapp_tracvl,iconser,iecri,idissip,iphysiq , &
    1515     &              periodav,iecrimoy,dayref,anneeref,                  &
    16      &              raz_date,offline,ip_ebil_dyn,config_inca
     16     &              raz_date,offline,ip_ebil_dyn,config_inca,           &
     17     &              planet_type,output_grads_dyn,ok_dynzon
    1718
    1819      INTEGER   nday,day_step,iperiod,iapp_tracvl,iconser,iecri,        &
    … …  
    2122      REAL periodav
    2223      logical offline
    23       CHARACTER*4 config_inca
     24      CHARACTER (len=4) :: config_inca
     25      CHARACTER(len=10) :: planet_type ! planet type ('earth','mars',...)
     26      LOGICAL :: output_grads_dyn ! output dynamics diagnostics in
     27                                  ! binary grads file 'dyn.dat' (y/n)
     28      LOGICAL :: ok_dynzon
    2429!-----------------------------------------------------------------------

  • LMDZ4/trunk/libf/dyn3dpar/covnat_p.F

    r1000 r1146  
    6161      END DO
    6262
    63       ijb=ij_begin
     63      ijb=ij_begin-iip1
    6464      ije=ij_end
     65      if (pole_nord) ijb=ij_begin
    6566      if (pole_sud)  ije=ij_end-iip1
    6667     

  • LMDZ4/trunk/libf/dyn3dpar/create_etat0_limit.F

    r1017 r1146  
    88       USE mod_const_mpi
    99       USE phys_state_var_mod     
     10       USE infotrac
    1011       IMPLICIT NONE
    1112c
    … …  
    3132#include "paramet.h"
    3233#include "indicesol.h"
    33 #include "advtrac.h"
    3434#include  "control.h"
    3535#include "clesphys.h"
    … …  
    3737!      REAL :: pctsrf(iim*(jjm-1)+2, nbsrf)
    3838
    39 c initialisation traceurs
    40       hadv_flg(:) = 0.
    41       vadv_flg(:) = 0.
    42       conv_flg(:) = 0.
    43       pbl_flg(:)  = 0.
    44       tracnam(:)  = '        '
    45       nprath = 1
    46       nbtrac = 0
    47       mmt_adj(:,:,:,:) = 1
    48 
    4939      IF (config_inca /= 'none') THEN
    5040#ifdef INCA
    5141         call init_const_lmdz(
    52      $        nbtrac,anneeref,dayref,
     42     $        nbtr,anneeref,dayref,
    5343     $        iphysiq,day_step,nday)
    5444#endif
    55          print *, 'nbtrac =' , nbtrac
     45         print *, 'nbtr =' , nbtr
    5646      END IF
    5747
    … …  
    5949
    6050
    61       CALL Init_Phys_lmdz(iim,jjp1,llm,nqmx-2,1,(/(jjm-1)*iim+2/))
     51      CALL Init_Phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
    6252      PRINT *,'---> klon=',klon
    6353

  • LMDZ4/trunk/libf/dyn3dpar/diagedyn.F

    r774 r1146  
    5858#include "paramet.h"
    5959#include "comgeom.h"
    60 
    61 #ifdef CPP_PHYS
     60#include "iniprint.h"
     61
     62#ifdef CPP_EARTH
    6263#include "../phylmd/YOMCST.h"
    6364#include "../phylmd/YOETHF.h"
    … …  
    139140
    140141
    141 #ifdef CPP_PHYS
     142#ifdef CPP_EARTH
    142143c======================================================================
    143144C     Compute Kinetic enrgy
    … …  
    314315C
    315316#else
    316       print*,'Pour l instant diagedyn a besoin de la physique'
     317      write(lunout,*),'diagedyn: Needs Earth physics to function'
    317318#endif
     319! #endif of #ifdef CPP_EARTH
    318320      RETURN
    319321      END

  • LMDZ4/trunk/libf/dyn3dpar/dynetat0.F

    r774 r1146  
    22! $Header$
    33!
    4       SUBROUTINE dynetat0(fichnom,nq,vcov,ucov,
     4      SUBROUTINE dynetat0(fichnom,vcov,ucov,
    55     .                    teta,q,masse,ps,phis,time)
     6      USE infotrac
    67      IMPLICIT NONE
    78
    … …  
    3233#include "serre.h"
    3334#include "logic.h"
    34 #include "advtrac.h"
    3535
    3636c   Arguments:
    … …  
    3838
    3939      CHARACTER*(*) fichnom
    40       INTEGER nq
    4140      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
    42       REAL q(ip1jmp1,llm,nq),masse(ip1jmp1,llm)
     41      REAL q(ip1jmp1,llm,nqtot),masse(ip1jmp1,llm)
    4342      REAL ps(ip1jmp1),phis(ip1jmp1)
    4443
    … …  
    5352
    5453c-----------------------------------------------------------------------
    55 
    5654c  Ouverture NetCDF du fichier etat initial
    5755
    … …  
    315313
    316314
    317       IF(nq.GE.1) THEN
    318       DO iq=1,nq
     315      DO iq=1,nqtot
    319316        ierr =  NF_INQ_VARID (nid, tname(iq), nvarid)
    320317        IF (ierr .NE. NF_NOERR) THEN
    … …  
    334331        ENDIF
    335332      ENDDO
    336       ENDIF
    337333
    338334      ierr = NF_INQ_VARID (nid, "masse", nvarid)

  • LMDZ4/trunk/libf/dyn3dpar/dynredem.F

    r1000 r1146  
    33!
    44c
    5       SUBROUTINE dynredem0(fichnom,iday_end,phis,nq)
     5      SUBROUTINE dynredem0(fichnom,iday_end,phis)
    66      USE IOIPSL
     7      USE infotrac
    78      IMPLICIT NONE
    89c=======================================================================
    … …  
    2223#include "description.h"
    2324#include "serre.h"
    24 #include "advtrac.h"
    2525
    2626c   Arguments:
    … …  
    2929      REAL phis(ip1jmp1)
    3030      CHARACTER*(*) fichnom
    31       INTEGER nq
    3231
    3332c   Local:
    … …  
    458457      dims4(3) = idim_s
    459458      dims4(4) = idim_tim
    460       IF(nq.GE.1) THEN
    461       DO iq=1,nq
     459
     460      DO iq=1,nqtot
    462461cIM 220306 BEG
    463462#ifdef NC_DOUBLE
    … …  
    469468      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,ttext(iq))
    470469      ENDDO
    471       ENDIF
    472470c
    473471      dims4(1) = idim_rlonv
    … …  
    508506      END
    509507      SUBROUTINE dynredem1(fichnom,time,
    510      .                     vcov,ucov,teta,q,nq,masse,ps)
     508     .                     vcov,ucov,teta,q,masse,ps)
     509      USE infotrac
    511510      IMPLICIT NONE
    512511c=================================================================
    … …  
    519518#include "comvert.h"
    520519#include "comgeom.h"
    521 #include "advtrac.h"
    522520#include "temps.h"
    523521#include "control.h"
    524522
    525       INTEGER nq, l
     523      INTEGER l
    526524      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
    527525      REAL teta(ip1jmp1,llm)                   
    528526      REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
    529       REAL q(ip1jmp1,llm,nq)
     527      REAL q(ip1jmp1,llm,nqtot)
    530528      CHARACTER*(*) fichnom
    531529     
    … …  
    633631      END IF
    634632
    635       IF(nq.GE.1) THEN
    636       do iq=1,nq
     633      do iq=1,nqtot
    637634
    638635         IF (config_inca == 'none') THEN
    … …  
    704701     
    705702      ENDDO
    706       ENDIF
    707703c
    708704      ierr = NF_INQ_VARID(nid, "masse", nvarid)

  • LMDZ4/trunk/libf/dyn3dpar/dynredem_p.F

    r1084 r1146  
    33!
    44c
    5       SUBROUTINE dynredem0_p(fichnom,iday_end,phis,nq)
     5      SUBROUTINE dynredem0_p(fichnom,iday_end,phis)
    66      USE IOIPSL
    77      USE parallel
     8      USE infotrac
    89      IMPLICIT NONE
    910c=======================================================================
    … …  
    2324#include "description.h"
    2425#include "serre.h"
    25 #include "advtrac.h"
    2626
    2727c   Arguments:
    … …  
    3030      REAL phis(ip1jmp1)
    3131      CHARACTER*(*) fichnom
    32       INTEGER nq
    3332
    3433c   Local:
    … …  
    5453      INTEGER yyears0,jjour0, mmois0
    5554      character*30 unites
    56 
    5755
    5856c-----------------------------------------------------------------------
    … …  
    461459      dims4(3) = idim_s
    462460      dims4(4) = idim_tim
    463       IF(nq.GE.1) THEN
    464       DO iq=1,nq
     461
     462      DO iq=1,nqtot
    465463cIM 220306 BEG
    466464#ifdef NC_DOUBLE
    … …  
    472470      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,ttext(iq))
    473471      ENDDO
    474       ENDIF
    475472c
    476473      dims4(1) = idim_rlonv
    … …  
    513510      END
    514511      SUBROUTINE dynredem1_p(fichnom,time,
    515      .                     vcov,ucov,teta,q,nq,masse,ps)
     512     .                     vcov,ucov,teta,q,masse,ps)
    516513      USE parallel
     514      USE infotrac
    517515      IMPLICIT NONE
    518516c=================================================================
    … …  
    525523#include "comvert.h"
    526524#include "comgeom.h"
    527 #include "advtrac.h"
    528525#include "temps.h"
    529526#include "control.h"
    530527
    531       INTEGER nq, l
     528      INTEGER l
    532529      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
    533530      REAL teta(ip1jmp1,llm)                   
    534531      REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
    535       REAL q(ip1jmp1,llm,nq)
     532      REAL q(ip1jmp1,llm,nqtot)
    536533      CHARACTER*(*) fichnom
    537534     
    … …  
    559556      call Gather_Field(ps,ip1jmp1,1,0)
    560557     
    561       do iq=1,nq
     558      do iq=1,nqtot
    562559        call Gather_Field(q(1,1,iq),ip1jmp1,llm,0)
    563560      enddo
    … …  
    660657      END IF
    661658
    662       IF(nq.GE.1) THEN
    663       do iq=1,nq
     659      do iq=1,nqtot
    664660
    665661         IF (config_inca == 'none') THEN
    … …  
    731727     
    732728      ENDDO
    733       ENDIF
    734 
    735729
    736730

  • LMDZ4/trunk/libf/dyn3dpar/etat0_netcdf.F

    r1058 r1146  
    55c
    66      SUBROUTINE etat0_netcdf (interbar, masque)
    7    
     7#ifdef CPP_EARTH       
    88      USE startvar
    99      USE ioipsl
    … …  
    1212      USE pbl_surface_mod
    1313      USE phys_state_var_mod
     14      USE filtreg_mod
     15      USE infotrac
     16#endif
     17!#endif of #ifdef CPP_EARTH
    1418      !
    1519      IMPLICIT NONE
    … …  
    2327!     .KLON=KFDIA-KIDIA+1,KLEV=llm
    2428      !
     29#ifdef CPP_EARTH   
    2530#include "comgeom2.h"
    2631#include "comvert.h"
    … …  
    2934#include "dimsoil.h"
    3035#include "temps.h"
    31       !
     36#endif
     37!#endif of #ifdef CPP_EARTH
     38      ! arguments:
    3239      LOGICAL interbar
     40      REAL :: masque(iip1,jjp1)
     41
     42#ifdef CPP_EARTH
     43      ! local variables:
    3344      REAL :: latfi(klon), lonfi(klon)
    34       REAL :: orog(iip1,jjp1), rugo(iip1,jjp1), masque(iip1,jjp1),
     45      REAL :: orog(iip1,jjp1), rugo(iip1,jjp1),
    3546     . psol(iip1, jjp1), phis(iip1, jjp1)
    3647      REAL :: p3d(iip1, jjp1, llm+1)
    … …  
    3849      REAL :: vvent(iip1, jjm, llm)
    3950      REAL :: t3d(iip1, jjp1, llm), tpot(iip1, jjp1, llm)
    40       REAL :: q3d(iip1, jjp1, llm,nqmx), qsat(iip1, jjp1, llm)
     51      REAL :: qsat(iip1, jjp1, llm)
     52      REAL,ALLOCATABLE :: q3d(:, :, :,:)
    4153      REAL :: tsol(klon), qsol(klon), sn(klon)
    4254      REAL :: tsolsrf(klon,nbsrf), qsolsrf(klon,nbsrf),snsrf(klon,nbsrf)
    … …  
    141153      !
    142154      preff     = 101325.
     155      pa        =  50000.
    143156      unskap = 1./kappa
    144157      !
    … …  
    164177      print*,'dtvr',dtvr
    165178
    166       CALL inicons0()
     179      CALL iniconst()
    167180      CALL inigeom()
    168181      !
    169182      CALL inifilr()
     183C init pour traceurs
     184      call infotrac_init
     185      ALLOCATE(q3d(iip1, jjp1, llm,nqtot))
    170186!      CALL phys_state_var_init()
    171187      !
    … …  
    623639      phis(iip1,:) = phis(1,:)
    624640
    625 C init pour traceurs
    626       call iniadvtrac(nq)
    627641C Ecriture
    628642      CALL inidissip( lstardis, nitergdiv, nitergrot, niterh   ,
    … …  
    648662     *                phi,w, pbaru,pbarv,time+iday-dayref   )
    649663       print*,'sortie caldyn0'     
    650       CALL dynredem0("start.nc",dayref,phis,nqmx)
     664      CALL dynredem0("start.nc",dayref,phis)
    651665      print*,'sortie dynredem0'
    652       CALL dynredem1("start.nc",0.0,vvent,uvent,tpot,q3d,nqmx,masse ,
     666      CALL dynredem1("start.nc",0.0,vvent,uvent,tpot,q3d,masse ,
    653667     .                            psol)
    654668      print*,'sortie dynredem1'
    … …  
    742756      visu_file='Etat0_visu.nc'
    743757      CALL initdynav(visu_file,dayref,anneeref,time_step,
    744      .              t_ops, t_wrt, nqmx, visuid)
    745       CALL writedynav(visuid, nqmx, itau,vvent ,
     758     .              t_ops, t_wrt, visuid)
     759      CALL writedynav(visuid, itau,vvent ,
    746760     .                uvent,tpot,pk,phi,q3d,masse,psol,phis)
    747761      else
    … …  
    750764      print*,'entree histclo'
    751765      CALL histclo
     766
     767#endif
     768!#endif of #ifdef CPP_EARTH
    752769      RETURN
    753770      !

  • LMDZ4/trunk/libf/dyn3dpar/filtreg_p.F

    r985 r1146  
    22
    33      SUBROUTINE filtreg_p ( champ, ibeg, iend, nlat, nbniv,
    4      .                       ifiltre, iaire, griscal ,iter)
    5       USE Parallel, only : OMP_CHUNK 
     4     &     ifiltre, iaire, griscal ,iter)
     5      USE Parallel, only : OMP_CHUNK
    66      USE mod_filtre_fft
    77      USE timer_filtre
     8     
     9      USE filtreg_mod
     10     
    811      IMPLICIT NONE
    9 
     12     
    1013c=======================================================================
    1114c
    … …  
    5053#include "dimensions.h"
    5154#include "paramet.h"
    52 #include "parafilt.h"
    5355#include "coefils.h"
    5456c
    … …  
    5759      INTEGER iim2,immjm
    5860      INTEGER jdfil1,jdfil2,jffil1,jffil2,jdfil,jffil
    59 
     61     
    6062      REAL  champ( iip1,nlat,nbniv)
    61       REAL matriceun,matriceus,matricevn,matricevs,matrinvn,matrinvs
    62       COMMON/matrfil/matriceun(iim,iim,nfilun),matriceus(iim,iim,nfilus)
    63      ,             , matricevn(iim,iim,nfilvn),matricevs(iim,iim,nfilvs)
    64      ,             ,  matrinvn(iim,iim,nfilun),matrinvs (iim,iim,nfilus)
    65 cym      REAL  eignq(iim), sdd1(iim),sdd2(iim)
    66 
    67       REAL  eignq(iim)
    68       REAL :: sdd1(iim),sdd2(iim)
    6963     
    7064      LOGICAL    griscal
    … …  
    7468      REAL :: champ_in(iip1,nlat,nbniv)
    7569     
    76       REAL,SAVE,TARGET :: sddu_loc(iim)
    77       REAL,SAVE,TARGET :: sddv_loc(iim)
    78       REAL,SAVE,TARGET :: unsddu_loc(iim)
    79       REAL,SAVE,TARGET :: unsddv_loc(iim)
    80 c$OMP THREADPRIVATE(sddu_loc,sddv_loc,unsddu_loc,unsddv_loc)
    8170      LOGICAL,SAVE     :: first=.TRUE.
    8271c$OMP THREADPRIVATE(first)
    8372
     73      REAL, DIMENSION(iip1,nlat,nbniv) :: champ_loc
     74      INTEGER :: ll_nb, nbniv_loc
     75      REAL, SAVE :: sdd12(iim,4)
     76c$OMP THREADPRIVATE(sdd12)
     77
     78      INTEGER, PARAMETER :: type_sddu=1
     79      INTEGER, PARAMETER :: type_sddv=2
     80      INTEGER, PARAMETER :: type_unsddu=3
     81      INTEGER, PARAMETER :: type_unsddv=4
     82
     83      INTEGER :: sdd1_type, sdd2_type
     84
    8485      IF (first) THEN
    85         sddu_loc(1:iim)=sddu(1:iim)
    86         sddv_loc(1:iim)=sddv(1:iim)
    87         unsddu_loc(1:iim)=unsddu(1:iim)
    88         unsddv_loc(1:iim)=unsddv(1:iim)
    89         CALL Init_timer
    90         first=.FALSE.
    91 c       PRINT *,"----> sddu_loc=",sddu_loc
    92 c       PRINT *,"----> sddv_loc=",sddv_loc
    93 c       PRINT *,"----> unsddu_loc=",unsddu_loc
    94 c       PRINT *,"----> unsddv_loc=",unsddv_loc
     86         sdd12(1:iim,type_sddu) = sddu(1:iim)
     87         sdd12(1:iim,type_sddv) = sddv(1:iim)
     88         sdd12(1:iim,type_unsddu) = unsddu(1:iim)
     89         sdd12(1:iim,type_unsddv) = unsddv(1:iim)
     90
     91         CALL Init_timer
     92         first=.FALSE.
    9593      ENDIF
    9694
    … …  
    9997c$OMP END MASTER
    10098
     99c-------------------------------------------------------c
     100
    101101      IF(ifiltre.EQ.1.or.ifiltre.EQ.-1)
    102      *    STOP'Pas de transformee simple dans cette version'
    103 
     102     &     STOP'Pas de transformee simple dans cette version'
     103     
    104104      IF( iter.EQ. 2 )  THEN
    105        PRINT *,' Pas d iteration du filtre dans cette version !'
    106      * , ' Utiliser old_filtreg et repasser !'
    107            STOP
     105         PRINT *,' Pas d iteration du filtre dans cette version !'
     106     &        , ' Utiliser old_filtreg et repasser !'
     107         STOP
    108108      ENDIF
    109109
    110110      IF( ifiltre.EQ. -2 .AND..NOT.griscal )     THEN
    111        PRINT *,' Cette routine ne calcule le filtre inverse que ',
    112      * ' sur la grille des scalaires !'
    113            STOP
     111         PRINT *,' Cette routine ne calcule le filtre inverse que '
     112     &        , ' sur la grille des scalaires !'
     113         STOP
    114114      ENDIF
    115115
    116116      IF( ifiltre.NE.2 .AND.ifiltre.NE. - 2 )  THEN
    117        PRINT *,' Probleme dans filtreg car ifiltre NE 2 et NE -2'
    118      *,' corriger et repasser !'
    119            STOP
     117         PRINT *,' Probleme dans filtreg car ifiltre NE 2 et NE -2'
     118     &        , ' corriger et repasser !'
     119         STOP
    120120      ENDIF
    121121c
    … …  
    127127      IF( griscal )   THEN
    128128         IF( nlat. NE. jjp1 )  THEN
    129              PRINT  1111
    130              STOP
     129            PRINT  1111
     130            STOP
    131131         ELSE
    132 c
    133              IF( iaire.EQ.1 )  THEN
    134 cym                CALL SCOPY(  iim,    sddv, 1,  sdd1, 1 )
    135 cym                CALL SCOPY(  iim,  unsddv, 1,  sdd2, 1 )
    136 cym               sdd1=>sddv_loc
    137 cym               sdd2=>unsddv_loc
    138                sdd1(1:iim)=sddv_loc(1:iim)
    139                sdd2(1:iim)=unsddv_loc(1:iim)
    140              ELSE
    141 cym                CALL SCOPY(  iim,  unsddv, 1,  sdd1, 1 )
    142 cym                CALL SCOPY(  iim,    sddv, 1,  sdd2, 1 )
    143                sdd1(1:iim)=unsddv_loc(1:iim)
    144                sdd2(1:iim)=sddv_loc(1:iim)
    145              END IF
    146 c
    147              jdfil1 = 2
    148              jffil1 = jfiltnu
    149              jdfil2 = jfiltsu
    150              jffil2 = jjm
    151           END IF
     132c     
     133            IF( iaire.EQ.1 )  THEN
     134               sdd1_type = type_sddv
     135               sdd2_type = type_unsddv
     136            ELSE
     137               sdd1_type = type_unsddv
     138               sdd2_type = type_sddv
     139            ENDIF
     140c
     141            jdfil1 = 2
     142            jffil1 = jfiltnu
     143            jdfil2 = jfiltsu
     144            jffil2 = jjm
     145         ENDIF
    152146      ELSE
    153           IF( nlat.NE.jjm )  THEN
    154              PRINT  2222
    155              STOP
    156           ELSE
    157 c
    158              IF( iaire.EQ.1 )  THEN
    159 cym                CALL SCOPY(  iim,    sddu, 1,  sdd1, 1 )
    160 cym                CALL SCOPY(  iim,  unsddu, 1,  sdd2, 1 )
    161 cym                sdd1=>sddu_loc
    162 cym                sdd2=>unsddu_loc
    163                 sdd1(1:iim)=sddu_loc(1:iim)
    164                 sdd2(1:iim)=unsddu_loc(1:iim)
    165 
    166              ELSE
    167 cym                CALL SCOPY(  iim,  unsddu, 1,  sdd1, 1 )
    168 cym                CALL SCOPY(  iim,    sddu, 1,  sdd2, 1 )
    169 cym               sdd1=>unsddu_loc
    170 cym               sdd2=>sddu_loc
    171                sdd1(1:iim)=unsddu_loc(1:iim)
    172                sdd2(1:iim)=sddu_loc(1:iim)
    173              END IF
    174 c
    175              jdfil1 = 1
    176              jffil1 = jfiltnv
    177              jdfil2 = jfiltsv
    178              jffil2 = jjm
    179           END IF
    180       END IF
    181 
    182 c      PRINT *,"APPEL a filtreg --> sdd1=",sdd1
    183 c      PRINT *,"APPEL a filtreg --> sdd2=",sdd2
    184 c      PRINT *,"----> sddu_loc=",sddu_loc
    185 c       PRINT *,"----> sddv_loc=",sddv_loc
    186 c       PRINT *,"----> unsddu_loc=",unsddu_loc
    187 c       PRINT *,"----> unsddv_loc=",unsddv_loc
    188  
    189 c
    190 c
    191       DO 100  hemisph = 1, 2
    192 c
    193       IF ( hemisph.EQ.1 )  THEN
    194 c ym
    195           jdfil = max(jdfil1,ibeg)
    196           jffil = min(jffil1,iend)
    197       ELSE
    198 c ym
    199           jdfil = max(jdfil2,ibeg)
    200           jffil = min(jffil2,iend)
    201       END IF
     147         IF( nlat.NE.jjm )  THEN
     148            PRINT  2222
     149            STOP
     150         ELSE
     151c
     152            IF( iaire.EQ.1 )  THEN
     153               sdd1_type = type_sddu
     154               sdd2_type = type_unsddu
     155            ELSE
     156               sdd1_type = type_unsddu
     157               sdd2_type = type_sddu
     158            ENDIF
     159c     
     160            jdfil1 = 1
     161            jffil1 = jfiltnv
     162            jdfil2 = jfiltsv
     163            jffil2 = jjm
     164         ENDIF
     165      ENDIF
     166c     
     167      DO hemisph = 1, 2
     168c     
     169         IF ( hemisph.EQ.1 )  THEN
     170cym
     171            jdfil = max(jdfil1,ibeg)
     172            jffil = min(jffil1,iend)
     173         ELSE
     174cym
     175            jdfil = max(jdfil2,ibeg)
     176            jffil = min(jffil2,iend)
     177         ENDIF
    202178
    203179
    … …  
    206182cccccccccccccccccccccccccccccccccccccccccccc
    207183
    208       IF (.NOT. use_filtre_fft) THEN
    209      
    210 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
    211       DO 50  l = 1, nbniv
    212         DO 30  j = jdfil,jffil
    213  
    214  
    215           DO  5  i = 1, iim
    216             champ(i,j,l) = champ(i,j,l) * sdd1(i)
    217    5      CONTINUE
    218 c
    219 
    220           IF( hemisph. EQ. 1 )      THEN
    221 
    222             IF( ifiltre. EQ. -2 )   THEN
    223 
    224 
    225               CALL SGEMV("N", iim,iim, 1.0, matrinvn(1,1,j),iim,
    226      .                     champ(1,j,l), 1, 0.0, eignq, 1)
    227 
    228 
    229             ELSE IF ( griscal )     THEN
    230 
    231               CALL SGEMV("N", iim,iim, 1.0, matriceun(1,1,j),iim,
    232      .                    champ(1,j,l), 1, 0.0, eignq, 1)
    233 
    234             ELSE
    235 
    236               CALL SGEMV("N", iim,iim, 1.0, matricevn(1,1,j),iim,
    237      .                   champ(1,j,l), 1, 0.0, eignq, 1)
    238             ENDIF
    239 
    240           ELSE
    241 
    242             IF( ifiltre. EQ. -2 )   THEN
    243      
    244               CALL SGEMV("N",iim,iim,1.0, matrinvs(1,1,j-jfiltsu+1),iim,
    245      .                   champ(1,j,l), 1, 0.0, eignq, 1)
    246      
    247             ELSE IF ( griscal )     THEN
    248      
    249               CALL SGEMV("N",iim,iim,1.0,matriceus(1,1,j-jfiltsu+1),iim,
    250      .                   champ(1,j,l), 1, 0.0, eignq, 1)
    251             ELSE
    252          
    253               CALL SGEMV("N",iim,iim,1.0,matricevs(1,1,j-jfiltsv+1),iim,
    254      .                    champ(1,j,l), 1, 0.0, eignq, 1)
    255             ENDIF
    256 
    257           ENDIF
    258 
    259 
    260 c
    261           IF( ifiltre.EQ. 2 )  THEN
    262          
    263             DO 15 i = 1, iim
    264               champ( i,j,l ) = ( champ(i,j,l) + eignq(i) ) * sdd2(i)
    265   15        CONTINUE
    266          
    267           ELSE
    268        
    269             DO 16 i=1,iim
    270                champ( i,j,l ) = ( champ(i,j,l) - eignq(i) ) * sdd2(i)
    271 16          CONTINUE
    272          
    273           ENDIF
    274 c
    275           champ( iip1,j,l ) = champ( 1,j,l )
    276 c
    277   30    CONTINUE
    278 c
    279   50  CONTINUE
     184         IF (.NOT. use_filtre_fft) THEN
     185     
     186c     !---------------------------------!
     187c     ! Agregation des niveau verticaux !
     188c     ! uniquement necessaire pour une  !
     189c     ! execution OpenMP                !
     190c     !---------------------------------!
     191            ll_nb = 0
     192c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     193            DO l = 1, nbniv
     194               ll_nb = ll_nb+1
     195               DO j = jdfil,jffil
     196                  DO i = 1, iim
     197                     champ_loc(i,j,ll_nb) =
     198     &                    champ(i,j,l) * sdd12(i,sdd1_type)
     199                  ENDDO
     200               ENDDO
     201            ENDDO
    280202c$OMP END DO NOWAIT
    281203
     204            nbniv_loc = ll_nb
     205
     206            IF( hemisph.EQ.1 )      THEN
     207               
     208               IF( ifiltre.EQ.-2 )   THEN
     209                  DO j = jdfil,jffil
     210                     CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0,
     211     &                    matrinvn(1,1,j), iim,
     212     &                    champ_loc(1,j,1), iip1*nlat, 0.0,
     213     &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
     214                  ENDDO
     215                 
     216               ELSE IF ( griscal )     THEN
     217                  DO j = jdfil,jffil
     218                     CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0,
     219     &                    matriceun(1,1,j), iim,
     220     &                    champ_loc(1,j,1), iip1*nlat, 0.0,
     221     &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
     222                  ENDDO
     223                 
     224               ELSE
     225                  DO j = jdfil,jffil
     226                     CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0,
     227     &                    matricevn(1,1,j), iim,
     228     &                    champ_loc(1,j,1), iip1*nlat, 0.0,
     229     &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
     230                  ENDDO
     231                 
     232               ENDIF
     233               
     234            ELSE
     235               
     236               IF( ifiltre.EQ.-2 )   THEN
     237                  DO j = jdfil,jffil
     238                     CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0,
     239     &                    matrinvs(1,1,j-jfiltsu+1), iim,
     240     &                    champ_loc(1,j,1), iip1*nlat, 0.0,
     241     &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
     242                  ENDDO
     243                 
     244               ELSE IF ( griscal )     THEN
     245                 
     246                  DO j = jdfil,jffil
     247                     CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0,
     248     &                    matriceus(1,1,j-jfiltsu+1), iim,
     249     &                    champ_loc(1,j,1), iip1*nlat, 0.0,
     250     &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
     251                  ENDDO
     252                 
     253               ELSE
     254                 
     255                  DO j = jdfil,jffil
     256                     CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0,
     257     &                    matricevs(1,1,j-jfiltsv+1), iim,
     258     &                    champ_loc(1,j,1), iip1*nlat, 0.0,
     259     &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
     260                  ENDDO
     261                 
     262               ENDIF
     263               
     264            ENDIF
     265!     c     
     266            IF( ifiltre.EQ.2 )  THEN
     267               
     268c     !-------------------------------------!
     269c     ! Dés-agregation des niveau verticaux !
     270c     ! uniquement necessaire pour une      !
     271c     ! execution OpenMP                    !
     272c     !-------------------------------------!
     273               ll_nb = 0
     274c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     275               DO l = 1, nbniv
     276                  ll_nb = ll_nb + 1
     277                  DO j = jdfil,jffil
     278                     DO i = 1, iim
     279                        champ( i,j,l ) = (champ_loc(i,j,ll_nb)
     280     &                       + champ_fft(i,j-jdfil+1,ll_nb))
     281     &                       * sdd12(i,sdd2_type)
     282                     ENDDO
     283                  ENDDO
     284               ENDDO
     285c$OMP END DO NOWAIT
     286               
     287            ELSE
     288               
     289               ll_nb = 0
     290c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     291               DO l = 1, nbniv_loc
     292                  ll_nb = ll_nb + 1
     293                  DO j = jdfil,jffil
     294                     DO i = 1, iim
     295                        champ( i,j,l ) = (champ_loc(i,j,ll_nb)
     296     &                       - champ_fft(i,j-jdfil+1,ll_nb))
     297     &                       * sdd12(i,sdd2_type)
     298                     ENDDO
     299                  ENDDO
     300               ENDDO
     301c$OMP END DO NOWAIT
     302               
     303            ENDIF
     304           
     305c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     306            DO l = 1, nbniv
     307               DO j = jdfil,jffil
     308                  champ( iip1,j,l ) = champ( 1,j,l )
     309               ENDDO
     310            ENDDO
     311c$OMP END DO NOWAIT
     312           
    282313ccccccccccccccccccccccccccccccccccccccccccccc
    283314c Utilisation du filtre FFT
    284315ccccccccccccccccccccccccccccccccccccccccccccc
    285316       
    286        ELSE
     317         ELSE
    287318       
    288319c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    289           DO l=1,nbniv
    290             DO j=jdfil,jffil
    291               DO  i = 1, iim
    292                 champ( i,j,l)= champ(i,j,l)*sdd1(i)
    293                 champ_fft( i,j,l) = champ(i,j,l)
    294               ENDDO
     320            DO l=1,nbniv
     321               DO j=jdfil,jffil
     322                  DO  i = 1, iim
     323                     champ( i,j,l)= champ(i,j,l)*sdd12(i,sdd1_type)
     324                     champ_fft( i,j,l) = champ(i,j,l)
     325                  ENDDO
     326               ENDDO
    295327            ENDDO
    296           ENDDO
    297328c$OMP END DO NOWAIT
    298329
    299       IF (jdfil<=jffil) THEN
    300         IF( ifiltre. EQ. -2 )   THEN
    301           CALL Filtre_inv_fft(champ_fft,nlat,jdfil,jffil,nbniv)
    302         ELSE IF ( griscal )     THEN
    303           CALL Filtre_u_fft(champ_fft,nlat,jdfil,jffil,nbniv)
    304         ELSE
    305           CALL Filtre_v_fft(champ_fft,nlat,jdfil,jffil,nbniv)
    306         ENDIF
    307       ENDIF
    308 
    309 
    310         IF( ifiltre.EQ. 2 )  THEN
     330            IF (jdfil<=jffil) THEN
     331               IF( ifiltre. EQ. -2 )   THEN
     332                  CALL Filtre_inv_fft(champ_fft,nlat,jdfil,jffil,nbniv)
     333               ELSE IF ( griscal )     THEN
     334                  CALL Filtre_u_fft(champ_fft,nlat,jdfil,jffil,nbniv)
     335               ELSE
     336                  CALL Filtre_v_fft(champ_fft,nlat,jdfil,jffil,nbniv)
     337               ENDIF
     338            ENDIF
     339
     340
     341            IF( ifiltre.EQ. 2 )  THEN
    311342c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)         
    312           DO l=1,nbniv
    313             DO j=jdfil,jffil
    314               DO  i = 1, iim
    315                 champ( i,j,l)=(champ(i,j,l)+champ_fft(i,j,l))
    316      .                             *sdd2(i)
    317               ENDDO
    318             ENDDO
    319           ENDDO
     343               DO l=1,nbniv
     344                  DO j=jdfil,jffil
     345                     DO  i = 1, iim
     346                        champ( i,j,l)=(champ(i,j,l)+champ_fft(i,j,l))
     347     &                       *sdd12(i,sdd2_type)
     348                     ENDDO
     349                  ENDDO
     350               ENDDO
    320351c$OMP END DO NOWAIT       
    321         ELSE
     352            ELSE
    322353       
    323354c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 
    324           DO l=1,nbniv
    325             DO j=jdfil,jffil
    326               DO  i = 1, iim
    327                 champ(i,j,l)=(champ(i,j,l)-champ_fft(i,j,l))
    328      .                            *sdd2(i)
    329               ENDDO
     355               DO l=1,nbniv
     356                  DO j=jdfil,jffil
     357                     DO  i = 1, iim
     358                        champ(i,j,l)=(champ(i,j,l)-champ_fft(i,j,l))
     359     &                       *sdd12(i,sdd2_type)
     360                     ENDDO
     361                  ENDDO
     362               ENDDO
     363c$OMP END DO NOWAIT         
     364            ENDIF
     365c
     366c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     367            DO l=1,nbniv
     368               DO j=jdfil,jffil
     369!            champ_FFT( iip1,j,l ) = champ_FFT( 1,j,l )
     370                  champ( iip1,j,l ) = champ( 1,j,l )
     371               ENDDO
    330372            ENDDO
    331           ENDDO
    332 c$OMP END DO NOWAIT         
    333         ENDIF
    334 c
    335 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    336         DO l=1,nbniv
    337           DO j=jdfil,jffil
    338 !            champ_FFT( iip1,j,l ) = champ_FFT( 1,j,l )
    339             champ( iip1,j,l ) = champ( 1,j,l )
    340           ENDDO
    341         ENDDO
    342373c$OMP END DO NOWAIT             
    343       ENDIF
     374         ENDIF
    344375c Fin de la zone de filtrage
    345376
    346377       
    347  100  CONTINUE
     378      ENDDO
    348379
    349380!      DO j=1,nlat
    … …  
    359390     
    360391c
    361 1111 FORMAT(//20x,'ERREUR dans le dimensionnement du tableau  CHAMP a
    362      *filtrer, sur la grille des scalaires'/)
    363 2222 FORMAT(//20x,'ERREUR dans le dimensionnement du tableau CHAMP a fi
    364      *ltrer, sur la grille de V ou de Z'/)
     392 1111 FORMAT(//20x,'ERREUR dans le dimensionnement du tableau  CHAMP a
     393     &     filtrer, sur la grille des scalaires'/)
     394 2222 FORMAT(//20x,'ERREUR dans le dimensionnement du tableau CHAMP a fi
     395     &     ltrer, sur la grille de V ou de Z'/)
    365396c$OMP MASTER     
    366397      CALL stop_timer

  • LMDZ4/trunk/libf/dyn3dpar/fluxstokenc_p.F

    r1021 r1146  
    6161        CALL initfluxsto_p( 'fluxstoke',
    6262     .  time_step,istdyn* time_step,istdyn* time_step,
    63      . nqmx, fluxid,fluxvid,fluxdid)
     63     . fluxid,fluxvid,fluxdid)
    6464       
    6565        ijb=ij_begin

  • LMDZ4/trunk/libf/dyn3dpar/gcm.F

    r1084 r1146  
    99      USE IOIPSL
    1010#endif
     11
    1112      USE mod_const_mpi, ONLY: init_const_mpi
    1213      USE parallel
    1314      USE mod_phys_lmdz_para, ONLY : klon_mpi_para_nb
    14       USE mod_grid_phy_lmdz
    15       USE mod_phys_lmdz_omp_data, ONLY: klon_omp
    16       USE dimphy
     15      USE infotrac
    1716      USE mod_interface_dyn_phys
    18       USE comgeomphy
    1917      USE mod_hallo
    2018      USE Bands
     19
     20      USE filtreg_mod
     21
     22! Ehouarn: for now these only apply to Earth:
     23#ifdef CPP_EARTH
     24      USE mod_grid_phy_lmdz
     25      USE mod_phys_lmdz_omp_data, ONLY: klon_omp
     26      USE dimphy
     27      USE comgeomphy
     28#endif
    2129      IMPLICIT NONE
    2230
    … …  
    6573#include "iniprint.h"
    6674#include "tracstoke.h"
    67 #include "advtrac.h"
    6875
    6976      INTEGER         longcles
    … …  
    8188      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
    8289      REAL teta(ip1jmp1,llm)                 ! temperature potentielle
    83       REAL q(ip1jmp1,llm,nqmx)              ! champs advectes
     90      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: q ! champs advectes
    8491      REAL ps(ip1jmp1)                       ! pression  au sol
    8592c      REAL p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
    … …  
    136143c    variables pour l'initialisation de la physique :
    137144c    ------------------------------------------------
    138       INTEGER ngridmx,nq
     145      INTEGER ngridmx
    139146      PARAMETER( ngridmx = 2+(jjm-1)*iim - 1/jjm   )
    140147      REAL zcufi(ngridmx),zcvfi(ngridmx)
    … …  
    158165
    159166
    160 c initialisation Anne
    161       hadv_flg(:) = 0.
    162       vadv_flg(:) = 0.
    163       conv_flg(:) = 0.
    164       pbl_flg(:)  = 0.
    165       tracnam(:)  = '        '
    166       nprath = 1
    167       nbtrac = 0
    168       mmt_adj(:,:,:,:) = 1
    169 
    170 
    171 c--------------------------------------------------------------------------
    172 c   Iflag_phys controle l'appel a la physique :
    173 c   -------------------------------------------
    174 c      0 : pas de physique
    175 c      1 : Normale (appel a phylmd, phymars ...)
    176 c      2 : rappel Newtonien pour la temperature + friction au sol
    177       iflag_phys=1
    178 
    179 c--------------------------------------------------------------------------
    180 c   Lecture de l'etat initial :
    181 c   ---------------------------
    182 c     T : on lit start.nc
    183 c     F : le modele s'autoinitialise avec un cas academique (iniacademic)
    184 #ifdef CPP_IOIPSL
    185       read_start=.true.
    186 #else
    187       read_start=.false.
    188 #endif
    189 
    190167c-----------------------------------------------------------------------
    191168c   Choix du calendrier
    … …  
    203180c  ---------------------------------------
    204181c
    205 #ifdef CPP_IOIPSL
     182! Ehouarn: dump possibility of using defrun
     183!#ifdef CPP_IOIPSL
    206184      CALL conf_gcm( 99, .TRUE. , clesphy0 )
    207 #else
    208       CALL defrun( 99, .TRUE. , clesphy0 )
    209 #endif
     185!#else
     186!      CALL defrun( 99, .TRUE. , clesphy0 )
     187!#endif
    210188c
    211189c
    … …  
    217195      call init_parallel
    218196      call Read_Distrib
    219       CALL Init_Phys_lmdz(iim,jjp1,llm,nqmx-2,mpi_size,distrib_phys)
     197! Ehouarn : temporarily (?) keep this only for Earth
     198      if (planet_type.eq."earth") then
     199#ifdef CPP_EARTH
     200        CALL Init_Phys_lmdz(iim,jjp1,llm,mpi_size,distrib_phys)
     201#endif
     202      endif ! of if (planet_type.eq."earth")
    220203      CALL set_bands
    221204      CALL Init_interface_dyn_phys
    … …  
    229212c$OMP END PARALLEL
    230213
     214! Ehouarn : temporarily (?) keep this only for Earth
     215      if (planet_type.eq."earth") then
     216#ifdef CPP_EARTH
    231217c$OMP PARALLEL
    232218      call InitComgeomphy
    233219c$OMP END PARALLEL
     220#endif
     221      endif ! of if (planet_type.eq."earth")
    234222
    235223      IF (config_inca /= 'none') THEN
    236224#ifdef INCA
    237225         call init_const_lmdz(
    238      $        nbtrac,anneeref,dayref,
     226     $        nbtr,anneeref,dayref,
    239227     $        iphysiq,day_step,nday)
    240228
    … …  
    248236c   Initialisation des traceurs
    249237c   ---------------------------
    250 c  Choix du schema pour l'advection
    251 c  dans fichier trac.def ou via INCA
    252 
    253        call iniadvtrac(nq)
    254 c
     238c  Choix du nombre de traceurs et du schema pour l'advection
     239c  dans fichier traceur.def, par default ou via INCA
     240      call infotrac_init
     241
     242c Allocation de la tableau q : champs advectes   
     243      ALLOCATE(q(ip1jmp1,llm,nqtot))
     244
    255245c-----------------------------------------------------------------------
    256246c   Lecture de l'etat initial :
    … …  
    259249c  lecture du fichier start.nc
    260250      if (read_start) then
    261 #ifdef CPP_IOIPSL
    262          CALL dynetat0("start.nc",nqmx,vcov,ucov,
     251      ! we still need to run iniacademic to initialize some
     252      ! constants & fields, if we run the 'newtonian' case:
     253        if (iflag_phys.eq.2) then
     254          CALL iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0)
     255        endif
     256!#ifdef CPP_IOIPSL
     257        if (planet_type.eq."earth") then
     258#ifdef CPP_EARTH
     259! Load an Earth-format start file
     260         CALL dynetat0("start.nc",vcov,ucov,
    263261     .              teta,q,masse,ps,phis, time_0)
     262#endif
     263        endif ! of if (planet_type.eq."earth")
    264264c       write(73,*) 'ucov',ucov
    265265c       write(74,*) 'vcov',vcov
    … …  
    268268c       write(77,*) 'q',q
    269269
    270 #endif
    271       endif
     270      endif ! of if (read_start)
    272271
    273272c le cas echeant, creation d un etat initial
    274273      IF (prt_level > 9) WRITE(lunout,*)
    275      .                 'AVANT iniacademic AVANT AVANT AVANT AVANT'
     274     .              'GCM: AVANT iniacademic AVANT AVANT AVANT AVANT'
    276275      if (.not.read_start) then
    277          CALL iniacademic(nqmx,vcov,ucov,teta,q,masse,ps,phis,time_0)
     276         CALL iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0)
    278277      endif
    279 
    280278
    281279c-----------------------------------------------------------------------
    … …  
    359357c   Initialisation de la physique :
    360358c   -------------------------------
    361 #ifdef CPP_PHYS
    362359      IF (call_iniphys.and.iflag_phys.eq.1) THEN
    363360         latfi(1)=rlatu(1)
    … …  
    380377
    381378         WRITE(lunout,*)
    382      .           'WARNING!!! vitesse verticale nulle dans la physique'
    383 
     379     .       'GCM: WARNING!!! vitesse verticale nulle dans la physique'
     380! Earth:
     381         if (planet_type.eq."earth") then
     382#ifdef CPP_EARTH
    384383         CALL iniphysiq(ngridmx,llm,daysec,day_ini,dtphys ,
    385384     ,                latfi,lonfi,airefi,zcufi,zcvfi,rad,g,r,cpp     )
    386 
     385#endif
     386         endif ! of if (planet_type.eq."earth")
    387387         call_iniphys=.false.
    388 
    389       ENDIF
    390 #endif
     388      ENDIF ! of IF (call_iniphys.and.(iflag_phys.eq.1))
    391389
    392390
    … …  
    404402
    405403c-----------------------------------------------------------------------
     404c   Initialisation des dimensions d'INCA :
     405c   --------------------------------------
     406      IF (config_inca /= 'none') THEN
     407!$OMP PARALLEL
     408#ifdef INCA
     409         CALL init_inca_dim(klon_omp,llm,iim,jjm,
     410     $        rlonu,rlatu,rlonv,rlatv)
     411#endif
     412!$OMP END PARALLEL
     413      END IF
     414
     415c-----------------------------------------------------------------------
    406416c   Initialisation des I/O :
    407417c   ------------------------
    … …  
    410420      day_end = day_ini + nday
    411421      WRITE(lunout,300)day_ini,day_end
     422 300  FORMAT('1'/,15x,'run du jour',i7,2x,'au jour',i7//)
     423
     424!#ifdef CPP_IOIPSL
     425      if (planet_type.eq."earth") then
     426#ifdef CPP_EARTH
     427      CALL dynredem0_p("restart.nc", day_end, phis)
     428#endif
     429      endif
     430
     431      ecripar = .TRUE.
    412432
    413433#ifdef CPP_IOIPSL
    414       CALL dynredem0_p("restart.nc", day_end, phis, nqmx)
    415 
    416       ecripar = .TRUE.
    417 
    418434      if ( 1.eq.1) then
    419435      time_step = zdtvr
    … …  
    421437      t_wrt = iecri * daysec
    422438      CALL inithist_p(dynhist_file,day_ref,annee_ref,time_step,
    423      .              t_ops, t_wrt, nqmx, histid, histvid)
    424 
    425       t_ops = iperiod * time_step
    426       t_wrt = periodav * daysec
    427       CALL initdynav_p(dynhistave_file,day_ref,annee_ref,time_step,
    428      .              t_ops, t_wrt, nqmx, histaveid)
    429 
     439     .              t_ops, t_wrt, histid, histvid)
     440
     441      IF (ok_dynzon) THEN
     442         t_ops = iperiod * time_step
     443         t_wrt = periodav * daysec
     444         CALL initdynav_p(dynhistave_file,day_ref,annee_ref,time_step,
     445     .        t_ops, t_wrt, histaveid)
     446      END IF
    430447      dtav = iperiod*dtvr/daysec
    431448      endif
    … …  
    433450
    434451#endif
     452! #endif of #ifdef CPP_IOIPSL
    435453
    436454c  Choix des frequences de stokage pour le offline
    … …  
    453471
    454472c$OMP PARALLEL DEFAULT(SHARED) COPYIN(/temps/,/logic/)
    455       CALL leapfrog_p(ucov,vcov,teta,ps,masse,phis,nq,q,clesphy0,
     473      CALL leapfrog_p(ucov,vcov,teta,ps,masse,phis,q,clesphy0,
    456474     .              time_0)
    457475c$OMP END PARALLEL
    458476
    459477
    460  300  FORMAT('1'/,15x,'run du pas',i7,2x,'au pas',i7,2x,
    461      . 'c''est a dire du jour',i7,3x,'au jour',i7//)
    462478      END
    463479

  • LMDZ4/trunk/libf/dyn3dpar/groupeun_p.F

    r764 r1146  
    1       subroutine groupeun_p(jjmax,llmax,jjb,jje,q)
     1      SUBROUTINE groupeun_p(jjmax,llmax,jjb,jje,q)
    22      USE parallel
    3       implicit none
     3      IMPLICIT NONE
    44
    55#include "dimensions.h"
    … …  
    88#include "comgeom2.h"
    99
    10       integer jjmax,llmax,jjb,jje
    11       real q(iip1,jjmax,llmax)
     10      INTEGER jjmax,llmax,jjb,jje
     11      REAL q(iip1,jjmax,llmax)
    1212
    13       integer ngroup
    14       parameter (ngroup=3)
     13      INTEGER ngroup
     14      PARAMETER (ngroup=3)
    1515
    16       real airen,airecn,qn
    17       real aires,airecs,qs
     16      REAL airecn,qn
     17      REAL airecs,qs
    1818
    19       integer i,j,l,ig,j1,j2,i0,jd
     19      INTEGER i,j,l,ig,j1,j2,i0,jd
    2020
    21 Champs 3D
     21c--------------------------------------------------------------------c
     22c Strategie d'optimisation                                           c
     23c stocker les valeurs systematiquement recalculees                   c
     24c et identiques d'un pas de temps sur l'autre. Il s'agit des         c
     25c aires des cellules qui sont sommees. S'il n'y a pas de changement  c
     26c de grille au cours de la simulation tout devrait bien se passer.   c
     27c Autre optimisation : determination des bornes entre lesquelles "j" c
     28c varie, au lieu de faire un test à chaque fois...
     29c--------------------------------------------------------------------c
     30
     31      INTEGER j_start, j_finish
     32
     33      REAL, SAVE :: airen_tab(iip1,jjp1,0:1)
     34      REAL, SAVE :: aires_tab(iip1,jjp1,0:1)
     35!$OMP THREADPRIVATE(airen_tab, aires_tab)
     36
     37      LOGICAL, SAVE :: first = .TRUE.
     38!$OMP THREADPRIVATE(first)
     39
     40      IF (first) THEN
     41         CALL INIT_GROUPEUN_P(airen_tab, aires_tab)
     42         first = .FALSE.
     43      ENDIF
     44
     45c Champs 3D
    2246      jd=jjp1-jjmax
    2347c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    24       do l=1,llm
    25       j1=1+jd
    26       j2=2
    27       do ig=1,ngroup
    28          do j=j1-jd,j2-jd
    29 c           print*,'groupe ',ig,'  j= ',j,2**(ngroup-ig+1),'pts groupes'
    30             if ( j >= jjb .AND. j <= jje) THEN
    31              
    32               do i0=1,iim,2**(ngroup-ig+1)
    33                  
    34                  airen=0.
    35                  airecn=0.
    36                  qn=0.
    37                  
    38                  do i=i0,i0+2**(ngroup-ig+1)-1
    39                     airen=airen+aire(i,j)
    40                     qn=qn+q(i,j,l)
    41                  enddo
    42                  airecn=0.
    43                  do i=i0,i0+2**(ngroup-ig+1)-1
    44                    q(i,j,l)=qn*aire(i,j)/airen
    45                  enddo
    46               enddo
    47               q(iip1,j,l)=q(1,j,l)
    48              
    49             endif
     48      DO l=1,llm
     49         j1=1+jd
     50         j2=2
     51         DO ig=1,ngroup
     52
     53c     Concerne le pole nord
     54            j_start  = MAX(jjb, j1-jd)
     55            j_finish = MIN(jje, j2-jd)
     56            DO j=j_start, j_finish
     57               DO i0=1,iim,2**(ngroup-ig+1)
     58                  qn=0.
     59                  DO i=i0,i0+2**(ngroup-ig+1)-1
     60                     qn=qn+q(i,j,l)
     61                  ENDDO
     62                  DO i=i0,i0+2**(ngroup-ig+1)-1
     63                     q(i,j,l)=qn*airen_tab(i,j,jd)
     64                  ENDDO
     65               ENDDO
     66               q(iip1,j,l)=q(1,j,l)
     67            ENDDO
     68       
     69!c     Concerne le pole sud
     70            j_start  = MAX(1+jjp1-jje-jd, j1-jd)
     71            j_finish = MIN(1+jjp1-jjb-jd, j2-jd)
     72            DO j=j_start, j_finish
     73               DO i0=1,iim,2**(ngroup-ig+1)
     74                  qs=0.
     75                  DO i=i0,i0+2**(ngroup-ig+1)-1
     76                     qs=qs+q(i,jjp1-j+1-jd,l)
     77                  ENDDO
     78                  DO i=i0,i0+2**(ngroup-ig+1)-1
     79                     q(i,jjp1-j+1-jd,l)=qs*aires_tab(i,jjp1-j+1,jd)
     80                  ENDDO
     81               ENDDO
     82               q(iip1,jjp1-j+1-jd,l)=q(1,jjp1-j+1-jd,l)
     83            ENDDO
     84       
     85            j1=j2+1
     86            j2=j2+2**ig
     87         ENDDO
     88      ENDDO
     89!$OMP END DO NOWAIT
     90
     91      RETURN
     92      END
     93
     94
     95
     96      SUBROUTINE INIT_GROUPEUN_P(airen_tab, aires_tab)
     97
     98      USE parallel
     99      IMPLICIT NONE
     100
     101#include "dimensions.h"
     102#include "paramet.h"
     103#include "comconst.h"
     104#include "comgeom2.h"
     105
     106      INTEGER ngroup
     107      PARAMETER (ngroup=3)
     108
     109      REAL airen,airecn
     110      REAL aires,airecs
     111
     112      INTEGER i,j,l,ig,j1,j2,i0,jd
     113
     114      INTEGER j_start, j_finish
     115
     116      REAL :: airen_tab(iip1,jjp1,0:1)
     117      REAL :: aires_tab(iip1,jjp1,0:1)
     118
     119      DO jd=0, 1
     120         j1=1+jd
     121         j2=2
     122         DO ig=1,ngroup
    50123           
    51             if ( jjp1-j+1-jd >= jjb .AND. jjp1-j+1-jd <= jje) THEN
    52              
    53               do i0=1,iim,2**(ngroup-ig+1)
    54                  aires=0.
    55                  airecs=0.
    56                  qs=0.
    57                  do i=i0,i0+2**(ngroup-ig+1)-1
    58                     aires=aires+aire(i,jjp1-j+1)
    59                     qs=qs+q(i,jjp1-j+1-jd,l)
    60                  enddo
    61                  airecs=0.
    62                  do i=i0,i0+2**(ngroup-ig+1)-1
    63                    q(i,jjp1-j+1-jd,l)=qs*aire(i,jjp1-j+1)/aires
    64                  enddo
    65               enddo
    66               q(iip1,jjp1-j+1-jd,l)=q(1,jjp1-j+1-jd,l)
    67            
    68             endif
    69          enddo
    70              
    71            j1=j2+1
    72            j2=j2+2**ig
    73       enddo
    74       enddo
    75 c$OMP END DO NOWAIT
    76       return
    77       end
     124!     c     Concerne le pole nord
     125            j_start = j1-jd
     126            j_finish = j2-jd
     127            DO j=j_start, j_finish
     128               DO i0=1,iim,2**(ngroup-ig+1)
     129                  airen=0.
     130                  DO i=i0,i0+2**(ngroup-ig+1)-1
     131                     airen = airen+aire(i,j)
     132                  ENDDO
     133                  DO i=i0,i0+2**(ngroup-ig+1)-1
     134                     airen_tab(i,j,jd) =
     135     &                    aire(i,j) / airen
     136                  ENDDO
     137               ENDDO
     138            ENDDO
     139           
     140!     c     Concerne le pole sud
     141            j_start = j1-jd
     142            j_finish = j2-jd
     143            DO j=j_start, j_finish
     144               DO i0=1,iim,2**(ngroup-ig+1)
     145                  aires=0.
     146                  DO i=i0,i0+2**(ngroup-ig+1)-1
     147                     aires=aires+aire(i,jjp1-j+1)
     148                  ENDDO
     149                  DO i=i0,i0+2**(ngroup-ig+1)-1
     150                     aires_tab(i,jjp1-j+1,jd) =
     151     &                    aire(i,jjp1-j+1) / aires
     152                  ENDDO
     153               ENDDO
     154            ENDDO
     155           
     156            j1=j2+1
     157            j2=j2+2**ig
     158         ENDDO
     159      ENDDO
     160     
     161      RETURN
     162      END

  • LMDZ4/trunk/libf/dyn3dpar/guide_p.F

    r1049 r1146  
    44      subroutine guide_pp(itau,ucov,vcov,teta,q,masse,ps)
    55      USE parallel
     6      use netcdf
    67
    78      IMPLICIT NONE
    … …  
    229230         IF (mpi_rank==0) THEN
    230231          if (guide_modele) then
    231             if (ncidpl.eq.-99) ncidpl=NCOPN('apbp.nc',NCNOWRIT,rcod)
    232           else 
    233            if (guide_u) then
    234             if (ncidpl.eq.-99) ncidpl=NCOPN('u.nc',NCNOWRIT,rcod)
    235           endif
    236 c
    237           if (guide_v) then
    238             if (ncidpl.eq.-99) ncidpl=NCOPN('v.nc',NCNOWRIT,rcod)
    239           endif
    240 c
    241           if (guide_T) then
    242             if (ncidpl.eq.-99) ncidpl=NCOPN('T.nc',NCNOWRIT,rcod)
    243           endif
    244 c
    245           if (guide_Q) then
    246             if (ncidpl.eq.-99) ncidpl=NCOPN('hur.nc',NCNOWRIT,rcod)
    247           endif
     232             if (ncidpl.eq.-99) rcod=nf90_open('apbp.nc',Nf90_NOWRITe,
     233     $            ncidpl)
     234          else
     235             if (guide_u) then
     236                if (ncidpl.eq.-99) rcod=nf90_open('u.nc',Nf90_NOWRITe,
     237     $               ncidpl)
     238             endif
     239c
     240             if (guide_v) then
     241                if (ncidpl.eq.-99) rcod=nf90_open('v.nc',nf90_nowrite,
     242     $               ncidpl)
     243             endif
     244c
     245             if (guide_T) then
     246                if (ncidpl.eq.-99) rcod=nf90_open('T.nc',nf90_nowrite,
     247     $               ncidpl)
     248             endif
     249c
     250             if (guide_Q) then
     251                if (ncidpl.eq.-99) rcod=nf90_open('hur.nc',nf90_nowrite,
     252     $               ncidpl)
     253             endif
    248254c
    249255          endif  !guide_modele
    … …  
    256262          status=NF_INQ_DIMLEN(ncidpl,rid,nlev)
    257263         print *,'nlev guide', nlev
    258          call ncclos(ncidpl,rcod)
     264         rcod = nf90_close(ncidpl)
    259265c   Lecture du premier etat des reanalyses.
    260266         call Gather_Field(ps,ip1jmp1,1,0)

  • LMDZ4/trunk/libf/dyn3dpar/iniacademic.F

    r774 r1146  
    44c
    55c
    6       SUBROUTINE iniacademic(nq,vcov,ucov,teta,q,masse,ps,phis,time_0)
     6      SUBROUTINE iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0)
     7
     8      USE filtreg_mod
     9      USE infotrac, ONLY : nqtot
    710
    811c%W%    %G%
    … …  
    4245#include "temps.h"
    4346#include "control.h"
     47#include "iniprint.h"
    4448
    4549c   Arguments:
    4650c   ----------
    4751
    48       integer nq
    4952      real time_0
    5053
    … …  
    5255      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
    5356      REAL teta(ip1jmp1,llm)                 ! temperature potentielle
    54       REAL q(ip1jmp1,llm,nq)               ! champs advectes
     57      REAL q(ip1jmp1,llm,nqtot)              ! champs advectes
    5558      REAL ps(ip1jmp1)                       ! pression  au sol
    5659      REAL masse(ip1jmp1,llm)                ! masse d'air
     60      REAL phis(ip1jmp1)                     ! geopotentiel au sol
     61
     62c   Local:
     63c   ------
     64
    5765      REAL p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
    5866      REAL pks(ip1jmp1)                      ! exner au  sol
    5967      REAL pk(ip1jmp1,llm)                   ! exner au milieu des couches
    6068      REAL pkf(ip1jmp1,llm)                  ! exner filt.au milieu des couches
    61       REAL phis(ip1jmp1)                     ! geopotentiel au sol
    6269      REAL phi(ip1jmp1,llm)                  ! geopotentiel
    63 
    64 
    65 
    66 
    67 
    68 c   Local:
    69 c   ------
    70 
    7170      REAL ddsin,tetarappelj,tetarappell,zsig
    7271      real tetajl(jjp1,llm)
    … …  
    7978
    8079c-----------------------------------------------------------------------
     80! 1. Initializations for Earth-like case
     81! --------------------------------------
     82      if (planet_type=="earth") then
     83c
     84        time_0=0.
    8185
    82 c
    83       time_0=0.
     86        im         = iim
     87        jm         = jjm
     88        day_ini    = 0
     89        omeg       = 4.*asin(1.)/86400.
     90        rad    = 6371229.
     91        g      = 9.8
     92        daysec = 86400.
     93        dtvr    = daysec/FLOAT(day_step)
     94        zdtvr=dtvr
     95        kappa  = 0.2857143
     96        cpp    = 1004.70885
     97        preff     = 101325.
     98        pa        =  50000.
     99        etot0      = 0.
     100        ptot0      = 0.
     101        ztot0      = 0.
     102        stot0      = 0.
     103        ang0       = 0.
    84104
    85       im         = iim
    86       jm         = jjm
    87       day_ini    = 0
    88       omeg       = 4.*asin(1.)/86400.
    89       rad    = 6371229.
    90       g      = 9.8
    91       daysec = 86400.
    92       dtvr    = daysec/FLOAT(day_step)
    93       zdtvr=dtvr
    94       kappa  = 0.2857143
    95       cpp    = 1004.70885
    96       preff     = 101325.
    97       pa        =  50 000.
    98       etot0      = 0.
    99       ptot0      = 0.
    100       ztot0      = 0.
    101       stot0      = 0.
    102       ang0       = 0.
    103       pa         = 0.
     105        CALL iniconst
     106        CALL inigeom
     107        CALL inifilr
    104108
    105       CALL inicons0
    106       CALL inigeom
    107       CALL inifilr
    108 
    109       ps=0.
    110       phis=0.
     109        ps=0.
     110        phis=0.
    111111c---------------------------------------------------------------------
    112112
    113       taurappel=10.*daysec
     113        taurappel=10.*daysec
    114114
    115115c---------------------------------------------------------------------
    … …  
    117117c   --------------------------------------
    118118
    119       DO l=1,llm
    120        zsig=ap(l)/preff+bp(l)
    121        if (zsig.gt.0.3) then
    122          lsup=l
    123          tetarappell=1./8.*(-log(zsig)-.5)
    124          DO j=1,jjp1
    125             ddsin=sin(rlatu(j))-sin(pi/20.)
    126             tetajl(j,l)=300.*(1+1./18.*(1.-3.*ddsin*ddsin)+tetarappell)
    127          ENDDO
    128         else
     119        DO l=1,llm
     120         zsig=ap(l)/preff+bp(l)
     121         if (zsig.gt.0.3) then
     122           lsup=l
     123           tetarappell=1./8.*(-log(zsig)-.5)
     124           DO j=1,jjp1
     125             ddsin=sin(rlatu(j))-sin(pi/20.)
     126             tetajl(j,l)=300.*(1+1./18.*(1.-3.*ddsin*ddsin)+tetarappell)
     127           ENDDO
     128          else
    129129c   Choix isotherme au-dessus de 300 mbar
    130          do j=1,jjp1
    131             tetajl(j,l)=tetajl(j,lsup)*(0.3/zsig)**kappa
    132          enddo
    133         endif
    134       ENDDO
     130           do j=1,jjp1
     131             tetajl(j,l)=tetajl(j,lsup)*(0.3/zsig)**kappa
     132           enddo
     133          endif ! of if (zsig.gt.0.3)
     134        ENDDO ! of DO l=1,llm
    135135
    136       do l=1,llm
    137          do j=1,jjp1
    138             do i=1,iip1
    139                ij=(j-1)*iip1+i
    140                tetarappel(ij,l)=tetajl(j,l)
    141             enddo
    142          enddo
    143       enddo
     136        do l=1,llm
     137           do j=1,jjp1
     138              do i=1,iip1
     139                 ij=(j-1)*iip1+i
     140                 tetarappel(ij,l)=tetajl(j,l)
     141              enddo
     142           enddo
     143        enddo
    144144
    145 c     call dump2d(jjp1,llm,tetajl,'TEQ   ')
     145c       call dump2d(jjp1,llm,tetajl,'TEQ   ')
    146146
    147       ps=1.e5
    148       phis=0.
    149       CALL pression ( ip1jmp1, ap, bp, ps, p       )
    150       CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
    151       CALL massdair(p,masse)
     147        ps=1.e5
     148        phis=0.
     149        CALL pression ( ip1jmp1, ap, bp, ps, p       )
     150        CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
     151        CALL massdair(p,masse)
    152152
    153153c  intialisation du vent et de la temperature
    154       teta(:,:)=tetarappel(:,:)
    155       CALL geopot(ip1jmp1,teta,pk,pks,phis,phi)
    156       call ugeostr(phi,ucov)
    157       vcov=0.
    158       q(:,:,1   )=1.e-10
    159       q(:,:,2   )=1.e-15
    160       q(:,:,3:nq)=0.
     154        teta(:,:)=tetarappel(:,:)
     155        CALL geopot(ip1jmp1,teta,pk,pks,phis,phi)
     156        call ugeostr(phi,ucov)
     157        vcov=0.
     158        q(:,:,1   )=1.e-10
     159        q(:,:,2   )=1.e-15
     160        q(:,:,3:nqtot)=0.
    161161
    162162
    163 c   perturbation al\351atoire sur la temp\351rature
    164       idum  = -1
    165       zz = ran1(idum)
    166       idum  = 0
    167       do l=1,llm
    168          do ij=iip2,ip1jm
    169             teta(ij,l)=teta(ij,l)*(1.+0.005*ran1(idum))
    170          enddo
    171       enddo
     163c   perturbation aleatoire sur la temperature
     164        idum  = -1
     165        zz = ran1(idum)
     166        idum  = 0
     167        do l=1,llm
     168           do ij=iip2,ip1jm
     169              teta(ij,l)=teta(ij,l)*(1.+0.005*ran1(idum))
     170           enddo
     171        enddo
    172172
    173       do l=1,llm
    174          do ij=1,ip1jmp1,iip1
    175             teta(ij+iim,l)=teta(ij,l)
    176          enddo
    177       enddo
     173        do l=1,llm
     174           do ij=1,ip1jmp1,iip1
     175              teta(ij+iim,l)=teta(ij,l)
     176           enddo
     177        enddo
    178178
    179179
    … …  
    185185
    186186c   initialisation d'un traceur sur une colonne
    187       j=jjp1*3/4
    188       i=iip1/2
    189       ij=(j-1)*iip1+i
    190       q(ij,:,3)=1.
    191 
     187        j=jjp1*3/4
     188        i=iip1/2
     189        ij=(j-1)*iip1+i
     190        q(ij,:,3)=1.
     191     
     192      else
     193        write(lunout,*)"iniacademic: planet types other than earth",
     194     &                 " not implemented (yet)."
     195        stop
     196      endif ! of if (planet_type=="earth")
    192197      return
    193198      END

  • LMDZ4/trunk/libf/dyn3dpar/initdynav_p.F

    r1000 r1146  
    44c
    55c
    6       subroutine initdynav_p(infile,day0,anne0,tstep,t_ops,t_wrt
    7      .                     ,nq,fileid)
     6      subroutine initdynav_p(infile,day0,anne0,tstep,t_ops,t_wrt,fileid)
    87
    98       USE IOIPSL
    … …  
    1110       use Write_field
    1211       use misc_mod
     12       USE infotrac
     13
    1314      implicit none
    1415
    … …  
    3031C      t_ops: frequence de l'operation pour IOIPSL
    3132C      t_wrt: frequence d'ecriture sur le fichier
    32 C      nq: nombre de traceurs
    3333C
    3434C   Sortie:
    … …  
    5050#include "description.h"
    5151#include "serre.h"
    52 #include "advtrac.h"
    5352
    5453C   Arguments
    … …  
    5857      real tstep, t_ops, t_wrt
    5958      integer fileid
    60       integer nq
    6159      integer thoriid, zvertiid
    6260
    … …  
    8280     
    8381      INTEGER :: dynave_domain_id
    84      
    8582     
    8683      if (adjust) return
    … …  
    169166C  Traceurs
    170167C
    171         DO iq=1,nq
     168        DO iq=1,nqtot
    172169          call histdef(fileid, ttext(iq), ttext(iq), '-',
    173170     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,

  • LMDZ4/trunk/libf/dyn3dpar/initfluxsto_p.F

    r1000 r1146  
    33!
    44      subroutine initfluxsto_p
    5      .  (infile,tstep,t_ops,t_wrt,nq,
     5     .  (infile,tstep,t_ops,t_wrt,
    66     .                    fileid,filevid,filedid)
    77
    … …  
    3030C      t_ops: frequence de l'operation pour IOIPSL
    3131C      t_wrt: frequence d'ecriture sur le fichier
    32 C      nq: nombre de traceurs
    3332C
    3433C   Sortie:
    … …  
    5857      real tstep, t_ops, t_wrt
    5958      integer fileid, filevid,filedid
    60       integer nq,ndex(1)
     59      integer ndex(1)
    6160      real nivd(1)
    6261
    … …  
    8786      INTEGER :: dynu_domain_id
    8887      INTEGER :: dynv_domain_id
    89 
    9088
    9189C

  • LMDZ4/trunk/libf/dyn3dpar/inithist_p.F

    r1000 r1146  
    22! $Header$
    33!
    4       subroutine inithist_p(infile,day0,anne0,tstep,t_ops,t_wrt,nq,
     4      subroutine inithist_p(infile,day0,anne0,tstep,t_ops,t_wrt,
    55     .                      fileid,filevid)
    66
    … …  
    99       use Write_field
    1010       use misc_mod
     11       USE infotrac
    1112
    1213      implicit none
    … …  
    2930C      t_ops: frequence de l'operation pour IOIPSL
    3031C      t_wrt: frequence d'ecriture sur le fichier
    31 C      nq: nombre de traceurs
    3232C
    3333C   Sortie:
    … …  
    5050#include "description.h"
    5151#include "serre.h"
    52 #include "advtrac.h"
    5352
    5453C   Arguments
    … …  
    5857      real tstep, t_ops, t_wrt
    5958      integer fileid, filevid
    60       integer nq
    6159
    6260C   Variables locales
    … …  
    8381      INTEGER :: dynu_domain_id
    8482      INTEGER :: dynv_domain_id
     83
    8584C
    8685C  Initialisations
    … …  
    217216C  Traceurs
    218217C
    219         DO iq=1,nq
     218        DO iq=1,nqtot
    220219          call histdef(fileid, ttext(iq),  ttext(iq), '-',
    221220     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,

  • LMDZ4/trunk/libf/dyn3dpar/integrd_p.F

    r985 r1146  
    3232#include "temps.h"
    3333#include "serre.h"
    34 #include "advtrac.h"
    3534
    3635c   Arguments:

  • LMDZ4/trunk/libf/dyn3dpar/leapfrog_p.F

    r1000 r1146  
    44c
    55c
    6 #define IO_DEBUG
    7 
    8 #undef CPP_IOIPSL
    9 #define CPP_IOIPSL
    10 
    11       SUBROUTINE leapfrog_p(ucov,vcov,teta,ps,masse,phis,nq,q,clesphy0,
     6
     7      SUBROUTINE leapfrog_p(ucov,vcov,teta,ps,masse,phis,q,clesphy0,
    128     &                    time_0)
    139
    … …  
    2117       USE vampir
    2218       USE timer_filtre, ONLY : print_filtre_timer
     19       USE infotrac
    2320
    2421      IMPLICIT NONE
    … …  
    6966#include "com_io_dyn.h"
    7067#include "iniprint.h"
    71 
    72 c#include "tracstoke.h"
    73 
    7468#include "academic.h"
    75 !#include "clesphys.h"
    76 #include "advtrac.h"
    7769     
    78       integer nq
    79 
    8070      INTEGER         longcles
    8171      PARAMETER     ( longcles = 20 )
    … …  
    8878      REAL :: vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
    8979      REAL :: teta(ip1jmp1,llm)                 ! temperature potentielle
    90       REAL :: q(ip1jmp1,llm,nqmx)               ! champs advectes
     80      REAL :: q(ip1jmp1,llm,nqtot)              ! champs advectes
    9181      REAL :: ps(ip1jmp1)                       ! pression  au sol
    9282      REAL,SAVE :: p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
    … …  
    10999c   tendances dynamiques
    110100      REAL,SAVE :: dv(ip1jm,llm),du(ip1jmp1,llm)
    111       REAL,SAVE :: dteta(ip1jmp1,llm),dq(ip1jmp1,llm,nqmx),dp(ip1jmp1)
     101      REAL,SAVE :: dteta(ip1jmp1,llm),dp(ip1jmp1)
     102      REAL,DIMENSION(:,:,:), ALLOCATABLE, SAVE :: dq
    112103
    113104c   tendances de la dissipation
    … …  
    118109      REAL,SAVE :: dvfi(ip1jm,llm),dufi(ip1jmp1,llm)
    119110      REAL,SAVE :: dtetafi(ip1jmp1,llm)
    120       REAL,SAVE :: dqfi(ip1jmp1,llm,nqmx),dpfi(ip1jmp1)
     111      REAL,SAVE :: dpfi(ip1jmp1)
     112      REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: dqfi
    121113
    122114c   variables pour le fichier histoire
    … …  
    186178      type(Request) :: Request_physic
    187179      REAL,SAVE :: dvfi_tmp(iip1,llm),dufi_tmp(iip1,llm)
    188       REAL,SAVE :: dtetafi_tmp(iip1,llm),dqfi_tmp(iip1,llm,nqmx)
     180      REAL,SAVE :: dtetafi_tmp(iip1,llm)
     181      REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: dqfi_tmp
    189182      REAL,SAVE :: dpfi_tmp(iip1)
    190183
    … …  
    195188      INTEGER :: var_time
    196189      LOGICAL :: ok_start_timer=.FALSE.
     190      LOGICAL, SAVE :: firstcall=.TRUE.
    197191
    198192c$OMP MASTER
    … …  
    208202      itaufin   = nday*day_step
    209203      itaufinp1 = itaufin +1
    210 
     204      modname="leapfrog_p"
    211205
    212206      itau = 0
    … …  
    217211          iday = iday+1
    218212         ENDIF
     213
     214c Allocate variables depending on dynamic variable nqtot
     215c$OMP MASTER
     216         IF (firstcall) THEN
     217            firstcall=.FALSE.
     218            ALLOCATE(dq(ip1jmp1,llm,nqtot))
     219            ALLOCATE(dqfi(ip1jmp1,llm,nqtot))
     220            ALLOCATE(dqfi_tmp(iip1,llm,nqtot))
     221         END IF
     222c$OMP END MASTER     
     223c$OMP BARRIER
    219224
    220225c-----------------------------------------------------------------------
    … …  
    276281c$OMP BARRIER
    277282       else
    278          
     283! Save fields obtained at previous time step as '...m1'
    279284         ijb=ij_begin
    280285         ije=ij_end
    … …  
    303308     .                    llm, -2,2, .TRUE., 1 )
    304309
    305        endif
     310       endif ! of if (FirstCaldyn)
    306311       
    307312      forward = .TRUE.
    … …  
    347352         IF( MOD(itau,idissip ).EQ.0.AND..NOT.forward ) apdiss = .TRUE.
    348353         IF( MOD(itau,iphysiq ).EQ.0.AND..NOT.forward
    349      s          .and. iflag_phys.NE.0                 ) apphys = .TRUE.
     354     s          .and. iflag_phys.EQ.1                 ) apphys = .TRUE.
    350355      ELSE
    351356         IF( MOD(itau   ,iconser) .EQ. 0              ) conser = .TRUE.
    352357         IF( MOD(itau+1,idissip)  .EQ. 0              ) apdiss = .TRUE.
    353          IF( MOD(itau+1,iphysiq).EQ.0.AND.iflag_phys.NE.0) apphys=.TRUE.
     358         IF( MOD(itau+1,iphysiq).EQ.0.AND.iflag_phys.EQ.1) apphys=.TRUE.
    354359      END IF
    355360
    … …  
    455460     &                                jj_Nb_caldyn,0,0,TestRequest)
    456461 
    457         do j=1,nqmx
     462        do j=1,nqtot
    458463         call Register_SwapFieldHallo(q(1,1,j),q(1,1,j),ip1jmp1,llm,
    459464     &                                jj_nb_caldyn,0,0,TestRequest)
    … …  
    490495       call Register_Hallo(p,ip1jmp1,llmp1,1,1,1,1,TestRequest)
    491496       
    492 c       do j=1,nqmx
     497c       do j=1,nqtot
    493498c         call Register_Hallo(q(1,1,j),ip1jmp1,llm,1,1,1,1,
    494499c     *                       TestRequest)
    … …  
    516521        call WriteField_p('pkf',reshape(pkf,(/iip1,jmp1,llm/)))
    517522        call WriteField_p('phis',reshape(phis,(/iip1,jmp1/)))
    518         do j=1,nqmx
     523        do j=1,nqtot
    519524          call WriteField_p('q'//trim(int2str(j)),
    520525     .                reshape(q(:,:,j),(/iip1,jmp1,llm/)))
    … …  
    528533
    529534c$OMP MASTER
    530       print*,"Iteration No",True_itau
     535      IF (prt_level>9) THEN
     536        WRITE(lunout,*)"leapfrog_p: Iteration No",True_itau
     537      ENDIF
    531538
    532539
    … …  
    585592
    586593
    587          ENDIF
    588 c
    589       ENDIF
     594         ENDIF ! of IF (offline)
     595c
     596      ENDIF ! of IF( forward. OR . leapf )
    590597cc$OMP END PARALLEL
    591598
    … …  
    608615c$OMP BARRIER
    609616!       CALL FTRACE_REGION_BEGIN("integrd")
     617
    610618       CALL integrd_p ( 2,vcovm1,ucovm1,tetam1,psm1,massem1 ,
    611619     $         dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis ,
    … …  
    625633c
    626634c      call WriteField_p('ps',reshape(ps,(/iip1,jmp1/)))
    627 c      do j=1,nqmx
     635c      do j=1,nqtot
    628636c        call WriteField_p('q'//trim(int2str(j)),
    629637c     .                reshape(q(:,:,j),(/iip1,jmp1,llm/)))
    … …  
    663671c$OMP MASTER
    664672         call suspend_timer(timer_caldyn)
    665          print*,'Entree dans la physique : Iteration No ',true_itau
     673
     674         write(lunout,*)
     675     &   'leapfrog_p: Entree dans la physique : Iteration No ',true_itau
    666676c$OMP END MASTER
    667677
    … …  
    669679
    670680c$OMP BARRIER
    671 
    672681         CALL exner_hyb_p(  ip1jmp1, ps, p,alpha,beta,pks, pk, pkf )
    673682c$OMP BARRIER
    … …  
    683692c   -----------------------------------------------------
    684693
    685 #ifdef CPP_PHYS
    686694c+jld
    687695
    … …  
    689697      IF (ip_ebil_dyn.ge.1 ) THEN
    690698          ztit='bil dyn'
    691           CALL diagedyn(ztit,2,1,1,dtphys
    692      e  , ucov    , vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2))
     699! Ehouarn: be careful, diagedyn is Earth-specific (includes ../phylmd/..)!
     700           IF (planet_type.eq."earth") THEN
     701            CALL diagedyn(ztit,2,1,1,dtphys
     702     &    , ucov    , vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2))
     703           ENDIF
    693704      ENDIF
    694705c-jld
    … …  
    725736       
    726737c        call SetDistrib(jj_nb_vanleer)
    727         do j=1,nqmx
     738        do j=1,nqtot
    728739 
    729740          call Register_SwapFieldHallo(q(1,1,j),q(1,1,j),ip1jmp1,llm,
    … …  
    756767cc$OMP BARRIER
    757768!        CALL FTRACE_REGION_BEGIN("calfis")
    758         CALL calfis_p( nq, lafin ,rdayvrai,time  ,
     769        CALL calfis_p(lafin ,rdayvrai,time  ,
    759770     $               ucov,vcov,teta,q,masse,ps,p,pk,phis,phi ,
    760771     $               du,dv,dteta,dq,
    … …  
    777788          dpfi_tmp(1:iip1)     = dpfi(ijb:ijb+iim) 
    778789c$OMP END MASTER
    779         endif
     790        endif ! of if ( .not. pole_nord)
    780791
    781792c$OMP BARRIER
    … …  
    799810     *                      1,0,0,1,Request_physic)
    800811
    801         do j=1,nqmx
     812        do j=1,nqtot
    802813          call Register_Hallo(dqfi(1,1,j),ip1jmp1,llm,
    803814     *                        1,0,0,1,Request_physic)
    … …  
    833844c$OMP END MASTER
    834845         
    835         endif
     846        endif ! of if (.not. pole_nord)
    836847c$OMP BARRIER
    837848cc$OMP MASTER       
    … …  
    842853cc$OMP END MASTER
    843854c     
    844 c      do j=1,nqmx
     855c      do j=1,nqtot
    845856c        call WriteField_p('dqfi'//trim(int2str(j)),
    846857c     .                reshape(dqfi(:,:,j),(/iip1,jmp1,llm/)))
    … …  
    853864         ENDIF
    854865       
    855           CALL addfi_p( nqmx, dtphys, leapf, forward   ,
     866          CALL addfi_p( dtphys, leapf, forward   ,
    856867     $                  ucov, vcov, teta , q   ,ps ,
    857868     $                 dufi, dvfi, dtetafi , dqfi ,dpfi  )
    … …  
    889900     *                               jj_Nb_caldyn,Request_physic)
    890901
    891         do j=1,nqmx
     902        do j=1,nqtot
    892903       
    893904          call Register_SwapField(q(1,1,j),q(1,1,j),ip1jmp1,llm,
    … …  
    922933cc$OMP END MASTER
    923934
    924 #else
    925 
     935
     936c-jld
     937c$OMP MASTER
     938         call resume_timer(timer_caldyn)
     939         if (FirstPhysic) then
     940           ok_start_timer=.TRUE.
     941           FirstPhysic=.false.
     942         endif
     943c$OMP END MASTER
     944       ENDIF ! of IF( apphys )
     945
     946      IF(iflag_phys.EQ.2) THEN ! "Newtonian" case
    926947c   Calcul academique de la physique = Rappel Newtonien + fritcion
    927948c   --------------------------------------------------------------
    … …  
    939960
    940961       call friction_p(ucov,vcov,iphysiq*dtvr)
    941 
    942 #endif
    943 
    944 c-jld
    945 c$OMP MASTER
    946          call resume_timer(timer_caldyn)
    947          if (FirstPhysic) then
    948            ok_start_timer=.TRUE.
    949            FirstPhysic=.false.
    950          endif
    951 c$OMP END MASTER
    952        ENDIF
     962      ENDIF ! of IF(iflag_phys.EQ.2)
     963
    953964
    954965        CALL pression_p ( ip1jmp1, ap, bp, ps, p                  )
    955966c$OMP BARRIER
    956 
    957 
    958967        CALL exner_hyb_p( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
    959968c$OMP BARRIER
    … …  
    12851294               ENDIF
    12861295#ifdef CPP_IOIPSL
     1296             IF (ok_dynzon) THEN
    12871297             call Register_Hallo(vcov,ip1jm,llm,1,0,0,1,TestRequest)
    12881298             call SendRequest(TestRequest)
    … …  
    12911301c$OMP BARRIER
    12921302c$OMP MASTER
    1293               CALL writedynav_p(histaveid, nqmx, itau,vcov ,
     1303              CALL writedynav_p(histaveid, itau,vcov ,
    12941304     ,                          ucov,teta,pk,phi,q,masse,ps,phis)
    1295 c$OMP END MASTER
    1296 
     1305
     1306c ATTENTION!!! bilan_dyn_p ne marche probablement pas avec OpenMP
     1307              CALL bilan_dyn_p(2,dtvr*iperiod,dtvr*day_step*periodav,
     1308     ,             ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
     1309c$OMP END MASTER
     1310              ENDIF !ok_dynzon
    12971311#endif
    12981312            ENDIF
    … …  
    13041318c      IF( MOD(itau,iecri         ).EQ.0) THEN
    13051319
    1306            IF( MOD(itau,iecri*day_step).EQ.0) THEN
    1307 c$OMP BARRIER
    1308 c$OMP MASTER
    1309                nbetat = nbetatdem
    1310         CALL geopot_p  ( ip1jmp1, teta  , pk , pks,  phis  , phi )
     1320            IF( MOD(itau,iecri*day_step).EQ.0) THEN
     1321c$OMP BARRIER
     1322c$OMP MASTER
     1323              nbetat = nbetatdem
     1324              CALL geopot_p(ip1jmp1,teta,pk,pks,phis,phi)
    13111325       
    13121326cym        unat=0.
    13131327       
    1314         ijb=ij_begin
    1315         ije=ij_end
    1316        
    1317         if (pole_nord) then
    1318           ijb=ij_begin+iip1
    1319           unat(1:iip1,:)=0.
    1320         endif
    1321        
    1322         if (pole_sud) then
    1323           ije=ij_end-iip1
    1324           unat(ij_end-iip1+1:ij_end,:)=0.
    1325         endif
     1328              ijb=ij_begin
     1329              ije=ij_end
     1330       
     1331              if (pole_nord) then
     1332                ijb=ij_begin+iip1
     1333                unat(1:iip1,:)=0.
     1334              endif
     1335       
     1336              if (pole_sud) then
     1337                ije=ij_end-iip1
     1338                unat(ij_end-iip1+1:ij_end,:)=0.
     1339              endif
    13261340           
    1327         do l=1,llm
    1328            unat(ijb:ije,l)=ucov(ijb:ije,l)/cu(ijb:ije)
    1329         enddo
    1330 
    1331         ijb=ij_begin
    1332         ije=ij_end
    1333         if (pole_sud) ije=ij_end-iip1
    1334        
    1335         do l=1,llm
    1336            vnat(ijb:ije,l)=vcov(ijb:ije,l)/cv(ijb:ije)
    1337         enddo
     1341              do l=1,llm
     1342                unat(ijb:ije,l)=ucov(ijb:ije,l)/cu(ijb:ije)
     1343              enddo
     1344
     1345              ijb=ij_begin
     1346              ije=ij_end
     1347              if (pole_sud) ije=ij_end-iip1
     1348       
     1349              do l=1,llm
     1350                vnat(ijb:ije,l)=vcov(ijb:ije,l)/cv(ijb:ije)
     1351              enddo
    13381352       
    13391353#ifdef CPP_IOIPSL
    13401354 
    1341         CALL writehist_p(histid,histvid, nqmx,itau,vcov,
    1342      s                       ucov,teta,phi,q,masse,ps,phis)
     1355              CALL writehist_p(histid,histvid, itau,vcov,
     1356     &                         ucov,teta,phi,q,masse,ps,phis)
    13431357
    13441358#endif
    1345 c$OMP END MASTER
    1346            ENDIF
     1359! For some Grads outputs of fields
     1360              if (output_grads_dyn) then
     1361! Ehouarn: hope this works the way I think it does:
     1362                  call Gather_Field(unat,ip1jmp1,llm,0)
     1363                  call Gather_Field(vnat,ip1jm,llm,0)
     1364                  call Gather_Field(teta,ip1jmp1,llm,0)
     1365                  call Gather_Field(ps,ip1jmp1,1,0)
     1366                  do iq=1,nqtot
     1367                    call Gather_Field(q(1,1,iq),ip1jmp1,llm,0)
     1368                  enddo
     1369                  if (mpi_rank==0) then
     1370#include "write_grads_dyn.h"
     1371                  endif
     1372              endif ! of if (output_grads_dyn)
     1373c$OMP END MASTER
     1374            ENDIF ! of IF(MOD(itau,iecri).EQ.0)
    13471375
    13481376            IF(itau.EQ.itaufin) THEN
    … …  
    13511379c$OMP MASTER
    13521380
    1353 c#ifdef CPP_IOIPSL
    1354 
    1355        CALL dynredem1_p("restart.nc",0.0,
    1356      ,                     vcov,ucov,teta,q,nqmx,masse,ps)
    1357 c#endif
     1381              if (planet_type.eq."earth") then
     1382#ifdef CPP_EARTH
     1383! Write an Earth-format restart file
     1384                CALL dynredem1_p("restart.nc",0.0,
     1385     &                           vcov,ucov,teta,q,masse,ps)
     1386
     1387#endif
     1388              endif ! of if (planet_type.eq."earth")
    13581389
    13591390              CLOSE(99)
    13601391c$OMP END MASTER
    1361             ENDIF
     1392            ENDIF ! of IF (itau.EQ.itaufin)
    13621393
    13631394c-----------------------------------------------------------------------
    … …  
    13901421                 dt  = 2.*dtvr
    13911422                 GO TO 2
    1392             END IF
    1393 
    1394       ELSE
     1423            END IF ! of IF (MOD(itau,iperiod).EQ.0)
     1424                   !    ELSEIF (MOD(itau-1,iperiod).EQ.0)
     1425
     1426
     1427      ELSE ! of IF (.not.purmats)
    13951428
    13961429c       ........................................................
    … …  
    14191452               GO TO 2
    14201453
    1421             ELSE
    1422 
    1423             IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN
     1454            ELSE ! of IF(forward)
     1455
     1456              IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN
    14241457               IF(itau.EQ.itaufin) THEN
    14251458                  iav=1
    … …  
    14281461               ENDIF
    14291462#ifdef CPP_IOIPSL
    1430 c$OMP BARRIER
    1431 
    1432               call Register_Hallo(vcov,ip1jm,llm,1,0,0,1,TestRequest)
    1433               call SendRequest(TestRequest)
    1434 c$OMP BARRIER
    1435               call WaitRequest(TestRequest)
    1436 
    1437 c$OMP BARRIER
    1438 c$OMP MASTER
    1439               CALL writedynav_p(histaveid, nqmx, itau,vcov ,
     1463               IF (ok_dynzon) THEN
     1464c$OMP BARRIER
     1465
     1466               call Register_Hallo(vcov,ip1jm,llm,1,0,0,1,TestRequest)
     1467               call SendRequest(TestRequest)
     1468c$OMP BARRIER
     1469               call WaitRequest(TestRequest)
     1470
     1471c$OMP BARRIER
     1472c$OMP MASTER
     1473               CALL writedynav_p(histaveid, itau,vcov ,
    14401474     ,                          ucov,teta,pk,phi,q,masse,ps,phis)
    1441                call bilan_dyn_p (2,dtvr*iperiod,dtvr*day_step*periodav,
     1475               CALL bilan_dyn_p(2,dtvr*iperiod,dtvr*day_step*periodav,
    14421476     ,           ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
    14431477c$OMP END MASTER
     1478               END IF !ok_dynzon
    14441479#endif
    1445             ENDIF
     1480              ENDIF ! of IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin)
     1481
    14461482
    14471483c               IF(MOD(itau,iecri         ).EQ.0) THEN
    … …  
    14491485c$OMP BARRIER
    14501486c$OMP MASTER
    1451                   nbetat = nbetatdem
    1452        CALL geopot_p( ip1jmp1, teta  , pk , pks,  phis  , phi   )
     1487                nbetat = nbetatdem
     1488                CALL geopot_p(ip1jmp1,teta,pk,pks,phis,phi)
    14531489
    14541490cym        unat=0.
    1455         ijb=ij_begin
    1456         ije=ij_end
    1457        
    1458         if (pole_nord) then
    1459           ijb=ij_begin+iip1
    1460           unat(1:iip1,:)=0.
    1461         endif
    1462        
    1463         if (pole_sud) then
    1464           ije=ij_end-iip1
    1465           unat(ij_end-iip1+1:ij_end,:)=0.
    1466         endif
     1491                ijb=ij_begin
     1492                ije=ij_end
     1493       
     1494                if (pole_nord) then
     1495                  ijb=ij_begin+iip1
     1496                  unat(1:iip1,:)=0.
     1497                endif
     1498       
     1499                if (pole_sud) then
     1500                  ije=ij_end-iip1
     1501                  unat(ij_end-iip1+1:ij_end,:)=0.
     1502                endif
    14671503           
    1468         do l=1,llm
    1469            unat(ijb:ije,l)=ucov(ijb:ije,l)/cu(ijb:ije)
    1470         enddo
    1471 
    1472         ijb=ij_begin
    1473         ije=ij_end
    1474         if (pole_sud) ije=ij_end-iip1
    1475        
    1476         do l=1,llm
    1477            vnat(ijb:ije,l)=vcov(ijb:ije,l)/cv(ijb:ije)
    1478         enddo
     1504                do l=1,llm
     1505                  unat(ijb:ije,l)=ucov(ijb:ije,l)/cu(ijb:ije)
     1506                enddo
     1507
     1508                ijb=ij_begin
     1509                ije=ij_end
     1510                if (pole_sud) ije=ij_end-iip1
     1511       
     1512                do l=1,llm
     1513                  vnat(ijb:ije,l)=vcov(ijb:ije,l)/cv(ijb:ije)
     1514                enddo
    14791515
    14801516#ifdef CPP_IOIPSL
    14811517
    1482        CALL writehist_p( histid, histvid, nqmx, itau,vcov ,
    1483      ,                           ucov,teta,phi,q,masse,ps,phis)
    1484 c#else
    1485 c      call Gather_Field(unat,ip1jmp1,llm,0)
    1486 c      call Gather_Field(vnat,ip1jm,llm,0)
    1487 c      call Gather_Field(teta,ip1jmp1,llm,0)
    1488 c      call Gather_Field(ps,ip1jmp1,1,0)
    1489 c      do iq=1,nqmx
    1490 c        call Gather_Field(q(1,1,iq),ip1jmp1,llm,0)
    1491 c      enddo
     1518                CALL writehist_p(histid, histvid, itau,vcov ,
     1519     &                           ucov,teta,phi,q,masse,ps,phis)
     1520#endif
     1521! For some Grads output (but does it work?)
     1522                if (output_grads_dyn) then
     1523                  call Gather_Field(unat,ip1jmp1,llm,0)
     1524                  call Gather_Field(vnat,ip1jm,llm,0)
     1525                  call Gather_Field(teta,ip1jmp1,llm,0)
     1526                  call Gather_Field(ps,ip1jmp1,1,0)
     1527                  do iq=1,nqtot
     1528                    call Gather_Field(q(1,1,iq),ip1jmp1,llm,0)
     1529                  enddo
    14921530c     
    1493 c      if (mpi_rank==0) then
    1494 c#include "write_grads_dyn.h"
    1495 c      endif
     1531                  if (mpi_rank==0) then
     1532#include "write_grads_dyn.h"
     1533                  endif
     1534                endif ! of if (output_grads_dyn)
     1535
     1536c$OMP END MASTER
     1537              ENDIF ! of IF(MOD(itau,iecri*day_step).EQ.0)
     1538
     1539              IF(itau.EQ.itaufin) THEN
     1540                if (planet_type.eq."earth") then
     1541#ifdef CPP_EARTH
     1542c$OMP MASTER
     1543                   CALL dynredem1_p("restart.nc",0.0,
     1544     .                               vcov,ucov,teta,q,masse,ps)
     1545c$OMP END MASTER
    14961546#endif
    1497 
    1498 c$OMP END MASTER
    1499                ENDIF
    1500 
    1501                  IF(itau.EQ.itaufin) THEN
    1502 c$OMP MASTER
    1503                    CALL dynredem1_p("restart.nc",0.0,
    1504      .                               vcov,ucov,teta,q,nqmx,masse,ps)
    1505 c$OMP END MASTER
    1506                  ENDIF
    1507                  forward = .TRUE.
    1508                  GO TO  1
    1509 
    1510             ENDIF
    1511 
    1512       END IF
    1513 c$OMP MASTER
    1514         call finalize_parallel
    1515 c$OMP END MASTER
    1516         RETURN
     1547                endif ! of if (planet_type.eq."earth")
     1548              ENDIF ! of IF(itau.EQ.itaufin)
     1549
     1550              forward = .TRUE.
     1551              GO TO  1
     1552
     1553            ENDIF ! of IF (forward)
     1554
     1555      END IF ! of IF(.not.purmats)
     1556c$OMP MASTER
     1557      call finalize_parallel
     1558c$OMP END MASTER
     1559      RETURN
    15171560      END

  • LMDZ4/trunk/libf/dyn3dpar/parallel.F90

    r1000 r1146  
    5151#else
    5252       using_mpi=.FALSE.
     53#endif
     54     
     55
     56#ifdef CPP_OMP
     57       using_OMP=.TRUE.
     58#else
     59       using_OMP=.FALSE.
    5360#endif
    5461     

  • LMDZ4/trunk/libf/dyn3dpar/qminimum_p.F

    r985 r1146  
    5050      DO 1000 k = 1, llm
    5151      DO 1040 i = ijb, ije
    52             zx_defau      = AMAX1( seuil_liq - q(i,k,iq_liq), 0.0 )
    53             q(i,k,iq_vap) = q(i,k,iq_vap) - zx_defau
    54             q(i,k,iq_liq) = q(i,k,iq_liq) + zx_defau
     52            if (seuil_liq - q(i,k,iq_liq) .gt. 0.d0 ) then
     53               q(i,k,iq_vap) = q(i,k,iq_vap) + q(i,k,iq_liq) - seuil_liq
     54               q(i,k,iq_liq) = seuil_liq
     55            endif
    5556 1040 CONTINUE
    5657 1000 CONTINUE
    … …  
    6970c$OMP DO SCHEDULE(STATIC)
    7071      DO i = ijb, ije
    71          zx_abc = deltap(i,k)/deltap(i,k-1)
    72          zx_defau    = AMAX1( seuil_vap - q(i,k,iq), 0.0 )
    73          q(i,k-1,iq) =  q(i,k-1,iq) - zx_defau * zx_abc
    74          q(i,k,iq)   =  q(i,k,iq)   + zx_defau 
     72         if ( seuil_vap - q(i,k,iq) .gt. 0.d0 ) then
     73            q(i,k-1,iq) =  q(i,k-1,iq) - ( seuil_vap - q(i,k,iq) ) *
     74     &           deltap(i,k) / deltap(i,k-1)
     75            q(i,k,iq)   =  seuil_vap 
     76         endif
    7577      ENDDO
    7678c$OMP END DO NOWAIT

  • LMDZ4/trunk/libf/dyn3dpar/read_reanalyse.F

    r1122 r1146  
    1111
    1212       USE parallel
     13       use netcdf
    1314c -----------------------------------------------------------------
    1415c   Declarations
    … …  
    7273            print *,'Vous êtes entrain de lire des données sur
    7374     .               niveaux modèle'
    74             ncidpl=NCOPN('apbp.nc',NCNOWRIT,rcode)
    75             varidap=NCVID(ncidpl,'AP',rcode)
    76             varidbp=NCVID(ncidpl,'BP',rcode)
     75            rcode=nf90_open('apbp.nc',nf90_nowrite,ncidpl)
     76            rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
     77            rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
    7778            print*,'ncidpl,varidap',ncidpl,varidap
    7879            endif
    … …  
    8081c Vent zonal
    8182            if (guide_u) then
    82                ncidu=NCOPN('u.nc',NCNOWRIT,rcode)
    83                varidu=NCVID(ncidu,'UWND',rcode)
     83               rcode=nf90_open('u.nc',nf90_nowrite,ncidu)
     84               rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
    8485               print*,'ncidu,varidu',ncidu,varidu
    8586               if (ncidpl.eq.-99) ncidpl=ncidu
    … …  
    8889c Vent meridien
    8990            if (guide_v) then
    90                ncidv=NCOPN('v.nc',NCNOWRIT,rcode)
    91                varidv=NCVID(ncidv,'VWND',rcode)
     91               rcode=nf90_open('v.nc',nf90_nowrite,ncidv)
     92               rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
    9293               print*,'ncidv,varidv',ncidv,varidv
    9394               if (ncidpl.eq.-99) ncidpl=ncidv
    … …  
    9697c Temperature
    9798            if (guide_T) then
    98                ncidt=NCOPN('T.nc',NCNOWRIT,rcode)
    99                varidt=NCVID(ncidt,'AIR',rcode)
     99               rcode=nf90_open('T.nc',nf90_nowrite,ncidt)
     100               rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
    100101               print*,'ncidt,varidt',ncidt,varidt
    101102               if (ncidpl.eq.-99) ncidpl=ncidt
    … …  
    104105c Humidite
    105106            if (guide_Q) then
    106                ncidQ=NCOPN('hur.nc',NCNOWRIT,rcode)
    107                varidQ=NCVID(ncidQ,'RH',rcode)
     107               rcode=nf90_open('hur.nc',nf90_nowrite,ncidQ)
     108               rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
    108109               print*,'ncidQ,varidQ',ncidQ,varidQ
    109110               if (ncidpl.eq.-99) ncidpl=ncidQ
    … …  
    112113c Pression de surface
    113114            if ((guide_P).OR.(guide_modele)) then
    114                ncidps=NCOPN('ps.nc',NCNOWRIT,rcode)
    115                varidps=NCVID(ncidps,'SP',rcode)
     115               rcode=nf90_open('ps.nc',nf90_nowrite,ncidps)
     116               rcode = nf90_inq_varid(ncidps, 'SP', varidps)
    116117               print*,'ncidps,varidps',ncidps,varidps
    117118            endif
    … …  
    119120c Coordonnee verticale
    120121            if (.not.guide_modele) then
    121               if (ncep) then
    122                print*,'Vous etes entrain de lire des donnees NCEP'
    123                varidpl=NCVID(ncidpl,'LEVEL',rcode)
    124             else
    125                print*,'Vous etes entrain de lire des donnees ECMWF'
    126                varidpl=NCVID(ncidpl,'PRESSURE',rcode)
    127               endif
    128               print*,'ncidpl,varidpl',ncidpl,varidpl
     122               if (ncep) then
     123                  print*,'Vous etes entrain de lire des donnees NCEP'
     124                  rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
     125               else
     126                  print*,'Vous etes entrain de lire des donnees ECMWF'
     127                  rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
     128               endif
     129               print*,'ncidpl,varidpl',ncidpl,varidpl
    129130            endif
    130131            print*,'ncidu,varidpl',ncidu,varidpl

  • LMDZ4/trunk/libf/dyn3dpar/serre.h

    r774 r1146  
    22! $Header$
    33!
    4 c
    5 c
    6 c..include serre.h
    7 c
    8        REAL clon,clat,transx,transy,alphax,alphay,pxo,pyo,
    9      ,  grossismx, grossismy, dzoomx, dzoomy,taux,tauy
    10        COMMON/serre/clon,clat,transx,transy,alphax,alphay,pxo,pyo ,
    11      ,  grossismx, grossismy, dzoomx, dzoomy,taux,tauy
     4!c
     5!c
     6!c..include serre.h
     7!c
     8       REAL clon,clat,transx,transy,alphax,alphay,pxo,pyo,              &
     9     &  grossismx, grossismy, dzoomx, dzoomy,taux,tauy
     10       COMMON/serre/clon,clat,transx,transy,alphax,alphay,pxo,pyo ,     &
     11     &  grossismx, grossismy, dzoomx, dzoomy,taux,tauy

  • LMDZ4/trunk/libf/dyn3dpar/test_period.F

    r774 r1146  
    33!
    44      SUBROUTINE test_period ( ucov, vcov, teta, q, p, phis )
     5      USE infotrac, ONLY : nqtot
    56c
    67c     Auteur : P. Le Van 
    … …  
    1718c
    1819      REAL ucov(ip1jmp1,llm), vcov(ip1jm,llm), teta(ip1jmp1,llm) ,
    19      ,      q(ip1jmp1,llm,nqmx), p(ip1jmp1,llmp1), phis(ip1jmp1)
     20     ,      q(ip1jmp1,llm,nqtot), p(ip1jmp1,llmp1), phis(ip1jmp1)
    2021c
    2122c   .....  Variables  locales  .....
    … …  
    6869     
    6970c
    70       DO nq =1, nqmx
     71      DO nq =1, nqtot
    7172        DO l =1, llm
    7273          DO ij = 1, ip1jmp1, iip1

  • LMDZ4/trunk/libf/dyn3dpar/times.F90

    r1000 r1146  
    207207      endif
    208208     
    209     ENDIF  ! using_mpî
     209    ENDIF  ! using_mp�
    210210  end subroutine allgather_timer_average
    211211 
    … …  
    222222  end subroutine InitTime
    223223 
    224   function DiffTime
     224  function DiffTime()
    225225  implicit none
    226226    double precision :: DiffTime
    … …  
    236236  end function DiffTime
    237237 
    238   function DiffCpuTime
     238  function DiffCpuTime()
    239239  implicit none
    240240    real :: DiffCpuTime

  • LMDZ4/trunk/libf/dyn3dpar/vlspltgen_p.F

    r985 r1146  
    2626      USE Write_Field_p
    2727      USE VAMPIR
     28      USE infotrac, ONLY : nqtot
    2829      IMPLICIT NONE
    2930
    … …  
    3839c   Arguments:
    3940c   ----------
    40       INTEGER iadv(nqmx)
     41      INTEGER iadv(nqtot)
    4142      REAL masse(ip1jmp1,llm),pente_max
    4243      REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm)
    43       REAL q(ip1jmp1,llm,nqmx)
     44      REAL q(ip1jmp1,llm,nqtot)
    4445      REAL w(ip1jmp1,llm),pdt
    4546      REAL p(ip1jmp1,llmp1),teta(ip1jmp1,llm),pk(ip1jmp1,llm)
    … …  
    5152c
    5253      REAL,SAVE :: qsat(ip1jmp1,llm)
    53       REAL,SAVE :: zm(ip1jmp1,llm,nqmx)
     54      REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: zm
    5455      REAL,SAVE :: mu(ip1jmp1,llm)
    5556      REAL,SAVE :: mv(ip1jm,llm)
    5657      REAL,SAVE :: mw(ip1jmp1,llm+1)
    57       REAL,SAVE :: zq(ip1jmp1,llm,nqmx)
     58      REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: zq
    5859      REAL zzpbar, zzw
    5960
    … …  
    6768      REAL tempe(ip1jmp1)
    6869      INTEGER ijb,ije,iq
     70      LOGICAL, SAVE :: firstcall=.TRUE.
     71!$OMP THREADPRIVATE(firstcall)
    6972      type(request) :: MyRequest1
    7073      type(request) :: MyRequest2
    … …  
    8487        rtt  = 273.16
    8588
     89c Allocate variables depending on dynamic variable nqtot
     90
     91         IF (firstcall) THEN
     92            firstcall=.FALSE.
     93!$OMP MASTER
     94            ALLOCATE(zm(ip1jmp1,llm,nqtot))
     95            ALLOCATE(zq(ip1jmp1,llm,nqtot))
     96!$OMP END MASTER
     97!$OMP BARRIER
     98         END IF
    8699c-- Calcul de Qsat en chaque point
    87100c-- approximation: au milieu des couches play(l)=(p(l)+p(l+1))/2
    … …  
    164177       ije=ij_end
    165178
    166       DO iq=1,nqmx
     179      DO iq=1,nqtot
    167180c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    168181        DO l=1,llm
    … …  
    175188
    176189c$OMP BARRIER           
    177       DO iq=1,nqmx
     190      DO iq=1,nqtot
    178191
    179192        if(iadv(iq) == 0) then
    … …  
    245258c$OMP END MASTER       
    246259c$OMP BARRIER
    247       do iq=1,nqmx
     260      do iq=1,nqtot
    248261
    249262        if(iadv(iq) == 0) then
    … …  
    285298c$OMP BARRIER
    286299 
    287       do iq=1,nqmx
     300      do iq=1,nqtot
    288301
    289302        if(iadv(iq) == 0) then
    … …  
    308321
    309322
    310       do iq=1,nqmx
     323      do iq=1,nqtot
    311324
    312325        if(iadv(iq) == 0) then
    … …  
    359372
    360373c$OMP BARRIER
    361       do iq=1,nqmx
     374      do iq=1,nqtot
    362375
    363376        if(iadv(iq) == 0) then
    … …  
    398411
    399412
    400       do iq=1,nqmx
     413      do iq=1,nqtot
    401414
    402415        if(iadv(iq) == 0) then
    … …  
    420433       enddo
    421434
    422       do iq=1,nqmx
     435      do iq=1,nqtot
    423436
    424437        if(iadv(iq) == 0) then
    … …  
    450463
    451464
    452       DO iq=1,nqmx
     465      DO iq=1,nqtot
    453466
    454467c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)         

  • LMDZ4/trunk/libf/dyn3dpar/write_grads_dyn.h

    r774 r1146  
    2424      string10='teta'
    2525      CALL wrgrads(1,llm,teta,string10,string10)
    26       do iq=1,nqmx
     26      do iq=1,nqtot
    2727         string10='q'
    2828         write(string10(2:2),'(i1)') iq

  • LMDZ4/trunk/libf/dyn3dpar/writedynav_p.F

    r1000 r1146  
    22! $Header$
    33!
    4       subroutine writedynav_p( histid, nq, time, vcov,
     4      subroutine writedynav_p( histid, time, vcov,
    55     ,                          ucov,teta,ppk,phi,q,masse,ps,phis)
    66
    … …  
    88      USE parallel
    99      USE misc_mod
     10      USE infotrac
    1011      implicit none
    1112
    … …  
    1718C   Entree:
    1819C      histid: ID du fichier histoire
    19 C      nqmx: nombre maxi de traceurs
    2020C      time: temps de l'ecriture
    2121C      vcov: vents v covariants
    … …  
    4747#include "description.h"
    4848#include "serre.h"
    49 #include "advtrac.h"
    5049
    5150C
    … …  
    5352C
    5453
    55       INTEGER histid, nq
     54      INTEGER histid
    5655      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
    5756      REAL teta(ip1jmp1,llm),phi(ip1jmp1,llm),ppk(ip1jmp1,llm)                 
    5857      REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
    5958      REAL phis(ip1jmp1)                 
    60       REAL q(ip1jmp1,llm,nq)
     59      REAL q(ip1jmp1,llm,nqtot)
    6160      integer time
    6261
    … …  
    105104C  Vents V scalaire
    106105C
    107       if (pole_sud) ije=ij_end-iip1
    108       if (pole_sud) jjn=jj_nb-1
    109106     
    110107      call gr_v_scal_p(llm, vnat, vs)
    … …  
    114111C  Temperature potentielle moyennee
    115112C
    116       ijb=ij_begin
    117       ije=ij_end
    118       jjn=jj_nb
    119      
     113     
    120114      call histwrite(histid, 'theta', itau_w, teta(ijb:ije,:),
    121115     .                iip1*jjn*llm, ndex3d)
    … …  
    139133C  Traceurs
    140134C
    141         DO iq=1,nq
     135        DO iq=1,nqtot
    142136          call histwrite(histid, ttext(iq), itau_w, q(ijb:ije,:,iq),
    143137     .                   iip1*jjn*llm, ndex3d)

  • LMDZ4/trunk/libf/dyn3dpar/writehist_p.F

    r1000 r1146  
    22! $Header$
    33!
    4       subroutine writehist_p( histid, histvid, nq, time, vcov,
     4      subroutine writehist_p( histid, histvid, time, vcov,
    55     ,                          ucov,teta,phi,q,masse,ps,phis)
    66
    … …  
    88      USE parallel
    99      USE misc_mod
     10      USE infotrac
    1011      implicit none
    1112
    … …  
    1819C      histid: ID du fichier histoire
    1920C      histvid:ID du fichier histoire pour les vents V (appele a disparaitre)
    20 C      nqmx: nombre maxi de traceurs
    2121C      time: temps de l'ecriture
    2222C      vcov: vents v covariants
    … …  
    4848#include "description.h"
    4949#include "serre.h"
    50 #include "advtrac.h"
    5150
    5251C
    … …  
    5453C
    5554
    56       INTEGER histid, nq, histvid
     55      INTEGER histid, histvid
    5756      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
    5857      REAL teta(ip1jmp1,llm),phi(ip1jmp1,llm)                   
    5958      REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
    6059      REAL phis(ip1jmp1)                 
    61       REAL q(ip1jmp1,llm,nq)
     60      REAL q(ip1jmp1,llm,nqtot)
    6261      integer time
    6362
    … …  
    119118C  Traceurs
    120119C
    121         DO iq=1,nq
     120        DO iq=1,nqtot
    122121          call histwrite(histid, ttext(iq), itau_w, q(ijb:ije,:,iq),
    123122     .                   iip1*jjn*llm, ndexu)
Note: See TracChangeset for help on using the changeset viewer.