Ignore:
Timestamp:
Jun 4, 2007, 4:13:10 PM (18 years ago)
Author:
Laurent Fairhead
Message:

Merge entre la version V3_conv et le HEAD
YM, JG, LF

Location:
LMDZ4/trunk/libf/dyn3dpar
Files:
77 edited

Legend:

Unmodified
Added
Removed

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

    r630 r764  
    8282      ije=ij_end
    8383     
     84c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    8485      DO k = 1,llm
    8586         DO j = ijb,ije
    … …  
    8788         ENDDO
    8889      ENDDO
     90c$OMP END DO NOWAIT
    8991
    9092      if (pole_nord) then
     93c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    9194        DO  k    = 1, llm
    9295         DO  ij   = 1, iim
    … …  
    99102         ENDDO
    100103       ENDDO
     104c$OMP END DO NOWAIT
    101105      endif
    102106
    103107      if (pole_sud) then
     108c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    104109        DO  k    = 1, llm
    105110         DO  ij   = 1, iim
    … …  
    112117         ENDDO
    113118       ENDDO
     119c$OMP END DO NOWAIT
    114120      endif
    115121c
    … …  
    119125      if (pole_nord) ijb=ij_begin+iip1
    120126      if (pole_sud)  ije=ij_end-iip1
    121      
     127
     128c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    122129      DO k = 1,llm
    123130         DO j = ijb,ije
    … …  
    125132         ENDDO
    126133      ENDDO
     134c$OMP END DO NOWAIT
    127135
    128136      if (pole_nord) ijb=ij_begin
    129137
     138c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    130139      DO k = 1,llm
    131140         DO j = ijb,ije
    … …  
    133142         ENDDO
    134143      ENDDO
     144c$OMP END DO NOWAIT
    135145
    136146c
    137147      if (pole_sud)  ije=ij_end
    138 
     148c$OMP MASTER
    139149      DO j = ijb,ije
    140150         pps(j) = pps(j) + pdpfi(j) * pdt
    141151      ENDDO
    142  
     152c$OMP END MASTER
    143153 
    144154      DO iq = 1, 2
     155c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    145156         DO k = 1,llm
    146157            DO j = ijb,ije
    … …  
    149160            ENDDO
    150161         ENDDO
    151       ENDDO
    152 
     162c$OMP END DO NOWAIT
     163      ENDDO
    153164
    154165      DO iq = 3, nq
     166c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    155167         DO k = 1,llm
    156168            DO j = ijb,ije
    … …  
    159171            ENDDO
    160172         ENDDO
    161       ENDDO
    162 
     173c$OMP END DO NOWAIT
     174      ENDDO
     175
     176c$OMP MASTER
    163177      if (pole_nord) then
    164178     
    … …  
    188202     
    189203      endif
     204c$OMP END MASTER
    190205
    191206      if (pole_nord) then
    192207        DO iq = 1, nq
     208c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    193209          DO  k    = 1, llm
    194210            DO  ij   = 1, iim
    … …  
    201217            ENDDO
    202218          ENDDO
     219c$OMP END DO NOWAIT       
    203220        ENDDO
    204221      endif
    … …  
    206223      if (pole_sud) then
    207224        DO iq = 1, nq
     225c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    208226          DO  k    = 1, llm
    209227            DO  ij   = 1, iim
    … …  
    216234            ENDDO
    217235          ENDDO
     236c$OMP END DO NOWAIT       
    218237        ENDDO
    219238      endif

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

    r630 r764  
    55c INCLUDE 'advtrac.h'
    66
    7       COMMON/advtr/iadv,hadv,vadv,tnom,tname,ttext,niadv
     7      COMMON/advtr/iadv,hadv,vadv,tnom,tname,ttext,niadv, 
     8     &     nbtrac, nprath, mmt_adj, hadv_flg, vadv_flg, conv_flg,
     9     &     pbl_flg, tracnam
    810      INTEGER iadv(nqmx) ! indice schema de transport
    911      INTEGER hadv(nqmx) ! indice schema transport horizontal
    … …  
    1315      character*10 tname(nqmx) ! nom du traceur pour restart
    1416      character*13 ttext(nqmx) ! nom long du traceur pour sorties
     17
     18      integer nbtrac
     19      integer nprath
     20      real    mmt_adj(iim+1,jjm+1,llm, 1)
     21      integer hadv_flg(nqmx)
     22      integer vadv_flg(nqmx)
     23      integer conv_flg(nqmx-2)
     24      integer pbl_flg(nqmx-2)
     25      character*8 tracnam(nqmx-2)
    1526c-----------------------------------------------------------------------

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

    r630 r764  
    44c
    55c
    6 #ifdef INCA_CH4
     6#ifdef INCA
    77      SUBROUTINE advtrac_p(pbaru,pbarv ,
    88     *                   p,  masse,q,iapptrac,teta,
    99     *                  flxw,
    10      *                  pk,
    11      *                  mmt_adj,
    12      *                  hadv_flg)
     10     *                  pk   )
    1311#else
    1412      SUBROUTINE advtrac_p(pbaru,pbarv ,
    … …  
    2523c
    2624      USE parallel
     25      USE Write_Field_p
    2726      USE Bands
    2827      USE mod_hallo
    … …  
    5655      REAL p( ip1jmp1,llmp1 ),teta(ip1jmp1,llm)
    5756      REAL pk(ip1jmp1,llm)
    58 #ifdef INCA_CH4
    59 cym      INTEGER            :: hadv_flg(nq)
    60          INTEGER            :: hadv_flg(nqmx)
    61 cym      REAL               :: mmt_adj(ip1jmp1,llm)
    62        REAL               :: mmt_adj(ip1jmp1,llm,1)
     57#ifdef INCA
    6358       REAL               :: flxw(ip1jmp1,llm)
    6459#endif
    … …  
    7065      REAL pbaruc(ip1jmp1,llm),pbarvc(ip1jm,llm)
    7166      REAL massem(ip1jmp1,llm),zdp(ip1jmp1)
    72       REAL pbarug(ip1jmp1,llm),pbarvg(ip1jm,llm),wg(ip1jmp1,llm)
     67      REAL,SAVE::pbarug(ip1jmp1,llm),pbarvg(ip1jm,llm),wg(ip1jmp1,llm)
    7368      REAL (kind=kind(1.d0)) :: t_initial, t_final, tps_cpu
    7469      real cpuadv(nqmx)
    … …  
    7873      INTEGER ij,l,iq,iiq
    7974      REAL zdpmin, zdpmax
    80       EXTERNAL  minmax
    8175      SAVE iadvtr, massem, pbaruc, pbarvc
    8276      DATA iadvtr/0/
     77c$OMP THREADPRIVATE(iadvtr)
    8378c----------------------------------------------------------
    8479c     Rajouts pour PPM
    … …  
    9893      integer ijb,ije,ijb_u,ijb_v,ije_u,ije_v,j
    9994      type(Request) :: Request_vanleer
    100       REAL p_tmp( ip1jmp1,llmp1 )
    101       REAL teta_tmp(ip1jmp1,llm)
    102       REAL pk_tmp(ip1jmp1,llm)
     95      REAL,SAVE :: p_tmp( ip1jmp1,llmp1 )
     96      REAL,SAVE :: teta_tmp(ip1jmp1,llm)
     97      REAL,SAVE :: pk_tmp(ip1jmp1,llm)
    10398     
    10499      ijb_u=ij_begin
    … …  
    113108c         CALL initial0(ijp1llm,pbaruc)
    114109c         CALL initial0(ijmllm,pbarvc)
    115          
    116           pbaruc(ijb_u:ije_u,:)=0.
    117           pbarvc(ijb_v:ije_v,:)=0.
    118          
     110c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
     111        DO l=1,llm   
     112          pbaruc(ijb_u:ije_u,l)=0.
     113          pbarvc(ijb_v:ije_v,l)=0.
     114        ENDDO
     115c$OMP END DO NOWAIT 
    119116      ENDIF
    120117
    121118c   accumulation des flux de masse horizontaux
     119c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    122120      DO l=1,llm
    123121         DO ij = ijb_u,ije_u
    … …  
    128126         ENDDO
    129127      ENDDO
     128c$OMP END DO NOWAIT
    130129
    131130c   selection de la masse instantannee des mailles avant le transport.
    … …  
    136135          ije=ij_end
    137136
    138           massem(ijb:ije,:)=masse(ijb:ije,:)
     137c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     138       DO l=1,llm
     139          massem(ijb:ije,l)=masse(ijb:ije,l)
     140       ENDDO
     141c$OMP END DO NOWAIT
     142
    139143ccc         CALL filtreg ( massem ,jjp1, llm,-2, 2, .TRUE., 1 )
    140144c
    … …  
    142146
    143147      iadvtr   = iadvtr+1
     148
     149c$OMP MASTER
    144150      iapptrac = iadvtr
    145 
     151c$OMP END MASTER
    146152
    147153c   Test pour savoir si on advecte a ce pas de temps
    148      
     154
    149155      IF ( iadvtr.EQ.iapp_tracvl ) THEN
     156c$OMP MASTER
    150157        call suspend_timer(timer_caldyn)
     158c$OMP END MASTER
    151159     
    152160      ijb=ij_begin
    153161      ije=ij_end
    154162     
     163
     164cc   ..  Modif P.Le Van  ( 20/12/97 )  ....
     165cc
     166
     167c   traitement des flux de masse avant advection.
     168c     1. calcul de w
     169c     2. groupement des mailles pres du pole.
     170
     171c$OMP BARRIER
     172        CALL groupe_p( massem, pbaruc,pbarvc, pbarug,pbarvg,wg )
     173c$OMP BARRIER
     174
     175c$OMP BARRIER
     176c$OMP MASTER     
    155177      p_tmp(ijb:ije,1:llmp1)=p(ijb:ije,1:llmp1)
    156178      pk_tmp(ijb:ije,1:llm)=pk(ijb:ije,1:llm)
    157179      teta_tmp(ijb:ije,1:llm)=teta(ijb:ije,1:llm)
    158      
    159 
    160 cc   ..  Modif P.Le Van  ( 20/12/97 )  ....
    161 cc
    162 
    163 c   traitement des flux de masse avant advection.
    164 c     1. calcul de w
    165 c     2. groupement des mailles pres du pole.
    166 
    167         CALL groupe_p( massem, pbaruc,pbarvc, pbarug,pbarvg,wg )
    168 
    169180      call VTb(VTHallo)
    170181      call Register_SwapFieldHallo(pbarug,pbarug,ip1jmp1,llm,
    … …  
    195206      call VTb(VTadvection)
    196207      call start_timer(timer_vanleer)
    197 
    198      
    199 #ifdef INCA_CH4
     208c$OMP END MASTER
     209c$OMP BARRIER
     210     
     211#ifdef INCA
    200212      ! ... Flux de masse diaganostiques traceurs
    201213c      flxw = wg / FLOAT(iapp_tracvl)
    … …  
    211223         if (pole_sud) ije=ij_end-iip1
    212224         
    213          
     225c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)         
    214226         DO l=1,llm-1
    215227            DO ij = ijb+1,ije
    … …  
    241253
    242254         ENDDO
     255c$OMP END DO NOWAIT
    243256
    244257c-------------------------------------------------------------------
    … …  
    253266cym      ----> Revérifier lors de la parallélisation des autres schemas
    254267   
    255           call massbar_p(massem,massebx,masseby)         
    256 
     268cym          call massbar_p(massem,massebx,masseby)         
     269
     270          call vlspltgen_p( q,iadv, 2., massem, wg ,
     271     *                    pbarug,pbarvg,dtvr,p_tmp,pk_tmp,teta_tmp )
     272
     273         
     274          GOTO 1234     
    257275c-----------------------------------------------------------
    258276c     Appel des sous programmes d'advection
    … …  
    309327
    310328            call pentes_ini (q(1,1,iq),wg,massem,pbarug,pbarvg,0)
    311 #ifdef INCA_CH4
     329#ifdef INCA
    312330       do iiq = iq+1, iq+3
    313          q(:,:,iiq)=q(:,:,iiq)*mmt_adj(:,:,1)
     331         q(:,:,iiq)=q(:,:,iiq)*1
    314332       enddo
    315333#endif
    … …  
    328346           call  prather(q(1,1,iq),wg,massem,pbarug,pbarvg,
    329347     s                     n,dtbon)
    330 #ifdef INCA_CH4
     348#ifdef INCA
    331349       do iiq = iq+1, iq+9
    332          q(:,:,iiq)=q(:,:,iiq)*mmt_adj(:,:,1)
     350         q(:,:,iiq)=q(:,:,iiq)*1
    333351       enddo
    334352#endif
    … …  
    441459       end DO
    442460
     4611234  CONTINUE
     462c$OMP BARRIER
     463c$OMP MASTER
    443464      ijb=ij_begin
    444465      ije=ij_end
    … …  
    450471       ENDDO
    451472
     473
    452474       CALL qminimum_p( q, 2, finmasse )
    453475
    … …  
    455477c   on reinitialise a zero les flux de masse cumules
    456478c---------------------------------------------------
    457           iadvtr=0
     479c          iadvtr=0
    458480        call VTe(VTadvection)
    459481        call stop_timer(timer_vanleer)
    … …  
    465487        enddo
    466488
    467 #ifdef INCA_CH4
     489#ifdef INCA
    468490       call Register_SwapFieldHallo(flxw,flxw,ip1jmp1,llm,
    469491     *                             jj_nb_caldyn,0,0,Request_vanleer)
    … …  
    475497        call VTe(VThallo)
    476498        call resume_timer(timer_caldyn)
    477        
     499c$OMP END MASTER
     500c$OMP BARRIER   
     501          iadvtr=0
    478502       ENDIF ! if iadvtr.EQ.iapp_tracvl
    479503

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

    r630 r764  
    106106         DO j = 1,jjp1
    107107            DO i = 1,iim
    108                sqi = sqi + S0(i,j,l,9)
     108               sqi = sqi + S0(i,j,l,ntra)
    109109            ENDDO
    110110         ENDDO
    … …  
    483483        DO j = 1, jjp1
    484484          DO i = 1, iim
    485              sqf = sqf + S0(i,j,l,9)
     485             sqf = sqf + S0(i,j,l,ntra)
    486486          END DO 
    487487        END DO

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

    r630 r764  
    105105         DO j = 1,jjp1
    106106            DO i = 1,iim
    107                sqi = sqi + S0(i,j,l,9)
     107               sqi = sqi + S0(i,j,l,ntra)
    108108            ENDDO
    109109         ENDDO
    … …  
    307307         DO j = 1,jjp1
    308308            DO i = 1,iim
    309                sqf = sqf + S0(i,j,l,9)
     309               sqf = sqf + S0(i,j,l,ntra)
    310310            ENDDO
    311311         ENDDO

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

    r630 r764  
    103103          if (jjphy_para_begin(i)==jjphy_para_end(i-1)) then
    104104            jj_Nb_physic_bis(i)=jj_Nb_physic_bis(i)-1
    105           endif
     105          else
     106            jj_Nb_physic_bis(i-1)=jj_Nb_physic_bis(i-1)+1
     107            jj_Nb_physic_bis(i)=jj_Nb_physic_bis(i)-1
     108          endif
    106109        endif
    107110      enddo
    … …  
    401404        CLOSE(unit_number)   
    402405      else
    403         print *,'problème lors de l écriture des bandes'
     406        print *,'probleme lors de l ecriture des bandes'
    404407      endif
    405408       

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

    r630 r764  
    3737c
    3838      INTEGER   ij,l,ijb,ije,jjb,jje
    39       EXTERNAL  filtreg_p
    4039c
    4140c-----------------------------------------------------------------------
    … …  
    5049      jje=jj_end+1
    5150      if (pole_sud) jje=jj_end
    52                
     51
     52c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)               
    5353      DO l=1,llm
    5454   
    … …  
    5858       
    5959       ENDDO
     60c$OMP END DO NOWAIT
    6061c
    6162c-----------------------------------------------------------------------

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

    r630 r764  
    168168c   Initialisation
    169169c=====================================================================
     170      ndex3d=0
    170171      if (adjust) return
    171172     
    … …  
    342343      Q(:,jjb:jje,:,iang)=ang(:,jjb:jje,:)
    343344      Q(:,jjb:jje,:,iu)=unat(:,jjb:jje,:)
    344       Q(:,jjb:jje,:,iovap)=q(:,jjb:jje,:,1)
     345      Q(:,jjb:jje,:,iovap)=trac(:,jjb:jje,:,1)
    345346      Q(:,jjb:jje,:,iun)=1.
    346347

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

    r630 r764  
    44c
    55c
    6 #ifdef INCA_CH4
     6#ifdef INCA
    77            SUBROUTINE caladvtrac_p(q,pbaru,pbarv ,
    88     *                   p ,masse, dq ,  teta,
    99     *                   flxw,
    1010     *                   pk,
    11      *                   mmt_adj,
    12      *                   hadv_flg,iapptrac)
     11     *                   iapptrac)
    1312#else
    1413            SUBROUTINE caladvtrac_p(q,pbaru,pbarv ,
    … …  
    4140      REAL p( ip1jmp1,llmp1),q( ip1jmp1,llm,nqmx),dq( ip1jmp1,llm,2 )
    4241      REAL teta( ip1jmp1,llm),pk( ip1jmp1,llm)
    43 #ifdef INCA_CH4
    44 cym      INTEGER            :: hadv_flg(nq)
    45       INTEGER            :: hadv_flg(nqmx)
    46       REAL               :: mmt_adj(iip1,jjp1,llm)
     42#ifdef INCA
    4743      REAL               :: flxw(ip1jmp1,llm)
    4844#endif
    … …  
    5854c   ------
    5955
    60       EXTERNAL  advtrac,minmaxq, qminimum
    6156      INTEGER ij,l, iq, iapptrac
    6257      REAL finmasse(ip1jmp1,llm), dtvrtrac
    … …  
    7772
    7873c   advection
     74c      print *,'appel a advtrac'
    7975
    80 #ifdef INCA_CH4
     76#ifdef INCA
    8177      CALL advtrac_p( pbaru,pbarv,
    8278     *             p,  masse,q,iapptrac, teta,
    8379     .             flxw,
    84      .             pk,
    85      .             mmt_adj,
    86      .             hadv_flg)
     80     .             pk)
    8781#else
    8882      CALL advtrac_p( pbaru,pbarv,

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

    r630 r764  
    4646      REAL ps(ip1jmp1),phis(ip1jmp1)
    4747      REAL pk(iip1,jjp1,llm),pkf(ip1jmp1,llm)
    48       REAL vcont(ip1jm,llm),ucont(ip1jmp1,llm)
     48      REAL,SAVE :: vcont(ip1jm,llm),ucont(ip1jmp1,llm)
    4949      REAL phi(ip1jmp1,llm),masse(ip1jmp1,llm)
    5050      REAL dv(ip1jm,llm),du(ip1jmp1,llm)
    5151      REAL dteta(ip1jmp1,llm),dp(ip1jmp1)
     52      REAL w(ip1jmp1,llm)
    5253      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
    5354      REAL time
    … …  
    5657c   ------
    5758
    58       REAL ang(ip1jmp1,llm),p(ip1jmp1,llmp1)
    59       REAL massebx(ip1jmp1,llm),masseby(ip1jm,llm),psexbarxy(ip1jm)
    60       REAL vorpot(ip1jm,llm)
    61       REAL w(ip1jmp1,llm),ecin(ip1jmp1,llm),convm(ip1jmp1,llm)
    62       REAL bern(ip1jmp1,llm)
    63       REAL massebxy(ip1jm,llm)
    64    
    65 
     59      REAL,SAVE :: ang(ip1jmp1,llm)
     60      REAL,SAVE :: p(ip1jmp1,llmp1)
     61      REAL,SAVE :: massebx(ip1jmp1,llm),masseby(ip1jm,llm)
     62      REAL,SAVE :: psexbarxy(ip1jm)
     63      REAL,SAVE :: vorpot(ip1jm,llm)
     64      REAL,SAVE :: ecin(ip1jmp1,llm)
     65      REAL,SAVE :: bern(ip1jmp1,llm)
     66      REAL,SAVE :: massebxy(ip1jm,llm)
     67      REAL,SAVE :: convm(ip1jmp1,llm)
    6668      INTEGER   ij,l,ijb,ije,ierr
    6769
    … …  
    7274      CALL pression_p ( ip1jmp1, ap      , bp   ,  ps  , p            )
    7375cym      CALL psextbar (   ps   , psexbarxy                          )
     76c$OMP BARRIER
    7477      CALL massdair_p (    p   , masse                                )
    7578      CALL massbar_p  (   masse, massebx , masseby                    )
    … …  
    7780      CALL flumass_p  ( massebx, masseby , vcont, ucont ,pbaru, pbarv )
    7881      CALL dteta1_p   (   teta , pbaru   , pbarv, dteta               )
    79       CALL convmas_p  (   pbaru, pbarv   , convm                      )
    80 
     82      CALL convmas1_p  (   pbaru, pbarv   , convm                      )
     83c$OMP BARRIER     
     84      CALL convmas2_p  (   convm                      )
     85c$OMP BARRIER
    8186#ifdef DEBUG_IO
     87c$OMP BARRIER
     88c$OMP MASTER
    8289      call WriteField_p('ucont',reshape(ucont,(/iip1,jmp1,llm/)))
    8390      call WriteField_p('vcont',reshape(vcont,(/iip1,jjm,llm/)))
    … …  
    9198      call WriteField_p('dteta',reshape(dteta,(/iip1,jmp1,llm/)))
    9299      call WriteField_p('convm',reshape(convm,(/iip1,jmp1,llm/)))
     100c$OMP END MASTER
     101c$OMP BARRIER
    93102#endif     
    94103
     104c$OMP BARRIER
     105c$OMP MASTER
    95106      ijb=ij_begin
    96107      ije=ij_end
    … …  
    99110         dp( ij ) = convm( ij,1 ) / airesurg( ij )
    100111      ENDDO
    101 
     112c$OMP END MASTER
     113c$OMP BARRIER
     114c$OMP FLUSH
    102115      CALL vitvert_p ( convm  , w                                  )
    103116      CALL tourpot_p ( vcov   , ucov  , massebxy  , vorpot         )
    … …  
    105118
    106119#ifdef DEBUG_IO     
     120c$OMP BARRIER
     121c$OMP MASTER
    107122      call WriteField_p('w',reshape(w,(/iip1,jmp1,llm/)))
    108123      call WriteField_p('vorpot',reshape(vorpot,(/iip1,jjm,llm/)))
    109124      call WriteField_p('du',reshape(du,(/iip1,jmp1,llm/)))
    110125      call WriteField_p('dv',reshape(dv,(/iip1,jjm,llm/)))
     126c$OMP END MASTER
     127c$OMP BARRIER
    111128#endif     
    112129      CALL enercin_p ( vcov   , ucov  , vcont     , ucont  , ecin  )
    … …  
    115132
    116133#ifdef DEBUG_IO
     134c$OMP BARRIER
     135c$OMP MASTER
    117136      call WriteField_p('ecin',reshape(ecin,(/iip1,jmp1,llm/)))
    118137      call WriteField_p('bern',reshape(bern,(/iip1,jmp1,llm/)))
    119138      call WriteField_p('du',reshape(du,(/iip1,jmp1,llm/)))
    120139      call WriteField_p('dv',reshape(dv,(/iip1,jjm,llm/)))
     140      call WriteField_p('pkf',reshape(pkf,(/iip1,jmp1,llm/)))
     141c$OMP END MASTER
     142c$OMP BARRIER
    121143#endif
    122144     
    … …  
    126148      if (pole_nord) ijb=ij_begin
    127149      if (pole_sud) ije=ij_end
    128      
     150
     151c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
    129152      DO l=1,llm
    130153         DO ij=ijb,ije
    … …  
    132155        ENDDO
    133156      ENDDO
     157c$OMP END DO
    134158
    135 
    136       CALL advect_p( ang, vcov, teta, w, massebx, masseby,du,dv,dteta)
     159      CALL advect_new_p(ang,vcov,teta,w,massebx,masseby,du,dv,dteta)
    137160
    138161C  WARNING probleme de peridocite de dv sur les PC/linux. Pb d'arrondi
    … …  
    142165      if (pole_sud) ije=ij_end-iip1
    143166
     167c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    144168      DO l = 1, llm
    145169         DO ij = ijb, ije, iip1
    … …  
    152176         enddo
    153177      enddo
     178c$OMP END DO NOWAIT     
    154179c-----------------------------------------------------------------------
    155180c   Sorties eventuelles des variables de controle:

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

    r630 r764  
    2323     $                  pdq,
    2424     $                  pw,
    25 #ifdef INCA_CH4
     25#ifdef INCA
    2626     $                  flxw,
    2727#endif
    … …  
    4040      Use Write_field_p
    4141      USE Times
     42      USE IOPHY
    4243      IMPLICIT NONE
    4344c=======================================================================
    … …  
    148149
    149150      INTEGER i,j,l,ig0,ig,iq,iiq
    150       REAL zpsrf(klon)
    151       REAL zplev(klon,llm+1),zplay(klon,llm)
    152       REAL zphi(klon,llm),zphis(klon)
    153 c
    154       REAL zufi(klon,llm), zvfi(klon,llm)
    155       REAL ztfi(klon,llm),zqfi(klon,llm,nqmx)
    156 c
    157       REAL pcvgu(klon,llm), pcvgv(klon,llm)
    158       REAL pcvgt(klon,llm), pcvgq(klon,llm,2)
    159 c
    160       REAL pvervel(klon,llm)
    161 c
    162       REAL zdufi(klon,llm),zdvfi(klon,llm)
    163       REAL zdtfi(klon,llm),zdqfi(klon,llm,nqmx)
    164       REAL zdpsrf(klon)
    165 c
     151      REAL,ALLOCATABLE,SAVE :: zpsrf(:)
     152      REAL,ALLOCATABLE,SAVE :: zplev(:,:),zplay(:,:)
     153      REAL,ALLOCATABLE,SAVE :: zphi(:,:),zphis(:)
     154c
     155      REAL,ALLOCATABLE,SAVE :: zufi(:,:), zvfi(:,:)
     156      REAL,ALLOCATABLE,SAVE :: ztfi(:,:),zqfi(:,:,:)
     157c
     158      REAL,ALLOCATABLE,SAVE :: pcvgu(:,:), pcvgv(:,:)
     159      REAL,ALLOCATABLE,SAVE :: pcvgt(:,:), pcvgq(:,:,:)
     160c
     161      REAL,ALLOCATABLE,SAVE :: pvervel(:,:)
     162c
     163      REAL,ALLOCATABLE,SAVE :: zdufi(:,:),zdvfi(:,:)
     164      REAL,ALLOCATABLE,SAVE :: zdtfi(:,:),zdqfi(:,:,:)
     165      REAL,ALLOCATABLE,SAVE :: zdpsrf(:)
     166c
     167      REAL,ALLOCATABLE,SAVE :: zplev_omp(:,:)
     168      REAL,ALLOCATABLE,SAVE :: zplay_omp(:,:)
     169      REAL,ALLOCATABLE,SAVE :: zphi_omp(:,:)
     170      REAL,ALLOCATABLE,SAVE :: zphis_omp(:)
     171      REAL,ALLOCATABLE,SAVE :: presnivs_omp(:)
     172      REAL,ALLOCATABLE,SAVE :: zufi_omp(:,:)
     173      REAL,ALLOCATABLE,SAVE :: zvfi_omp(:,:)
     174      REAL,ALLOCATABLE,SAVE :: ztfi_omp(:,:)
     175      REAL,ALLOCATABLE,SAVE :: zqfi_omp(:,:,:)
     176      REAL,ALLOCATABLE,SAVE :: pvervel_omp(:,:)
     177      REAL,ALLOCATABLE,SAVE :: zdufi_omp(:,:)
     178      REAL,ALLOCATABLE,SAVE :: zdvfi_omp(:,:)
     179      REAL,ALLOCATABLE,SAVE :: zdtfi_omp(:,:)
     180      REAL,ALLOCATABLE,SAVE :: zdqfi_omp(:,:,:)
     181      REAL,ALLOCATABLE,SAVE :: zdpsrf_omp(:)
     182
     183c$OMP THREADPRIVATE(zplev_omp,zplay_omp,zphi_omp,zphis_omp,
     184c$OMP+                 presnivs_omp,zufi_omp,zvfi_omp,ztfi_omp,
     185c$OMP+                 zqfi_omp,pvervel_omp,zdufi_omp,zdvfi_omp,
     186c$OMP+                 zdtfi_omp,zdqfi_omp,zdpsrf_omp)       
     187
     188      LOGICAL,SAVE :: first_omp=.true.
     189c$OMP THREADPRIVATE(first_omp)
     190     
    166191      REAL zsin(iim),zcos(iim),z1(iim)
    167192      REAL zsinbis(iim),zcosbis(iim),z1bis(iim)
    168193      REAL unskap, pksurcp
    169 
    170 #ifdef INCA_CH4
     194c
     195cIM diagnostique PVteta, Amip2
     196      INTEGER ntetaSTD
     197      PARAMETER(ntetaSTD=3)
     198      REAL rtetaSTD(ntetaSTD)
     199      DATA rtetaSTD/350., 380., 405./
     200      REAL PVteta(klon,ntetaSTD)
     201     
     202#ifdef INCA
    171203      REAL flxw(iip1,jjp1,llm)
    172204      REAL flxwfi(klon,llm)
    … …  
    179211      DATA firstcal/.true./
    180212      SAVE firstcal,debut
     213c$OMP THREADPRIVATE(firstcal,debut)
    181214      REAL rdayvrai
    182215     
    183       REAL,dimension(1:iim,1:llm) :: du_send,du_recv,dv_send,dv_recv
     216      REAL,SAVE,dimension(1:iim,1:llm):: du_send,du_recv,dv_send,dv_recv
    184217      INTEGER :: ierr
    185218      INTEGER,dimension(MPI_STATUS_SIZE,4) :: Status
    186219      INTEGER, dimension(4) :: Req
    187       REAL zdufi2(klon+iim,llm),zdvfi2(klon+iim,llm)
    188       integer :: k,kstart,kend     
     220      REAL,ALLOCATABLE,SAVE:: zdufi2(:,:),zdvfi2(:,:)
     221      integer :: k,kstart,kend
     222      INTEGER :: offset 
    189223c
    190224c-----------------------------------------------------------------------
    … …  
    194228c
    195229
     230      klon=klon_mpi
     231     
     232      PVteta(:,:)=0.
     233           
    196234      IF (ngridmx.NE.2+(jjm-1)*iim) THEN
    197235         PRINT*,'STOP dans calfis'
    … …  
    209247      IF ( firstcal )  THEN
    210248          debut = .TRUE.
     249c$OMP MASTER
     250      ALLOCATE(zpsrf(klon))
     251      ALLOCATE(zplev(klon,llm+1),zplay(klon,llm))
     252      ALLOCATE(zphi(klon,llm),zphis(klon))
     253      ALLOCATE(zufi(klon,llm), zvfi(klon,llm))
     254      ALLOCATE(ztfi(klon,llm),zqfi(klon,llm,nqmx))
     255      ALLOCATE(pcvgu(klon,llm), pcvgv(klon,llm))
     256      ALLOCATE(pcvgt(klon,llm), pcvgq(klon,llm,2))
     257      ALLOCATE(pvervel(klon,llm))
     258      ALLOCATE(zdufi(klon,llm),zdvfi(klon,llm))
     259      ALLOCATE(zdtfi(klon,llm),zdqfi(klon,llm,nqmx))
     260      ALLOCATE(zdpsrf(klon))
     261      ALLOCATE(zdufi2(klon+iim,llm),zdvfi2(klon+iim,llm))
     262c$OMP END MASTER
     263c$OMP BARRIER     
    211264      ELSE
    212265          debut = .FALSE.
    … …  
    222275c   ----------------------------------
    223276
     277c$OMP MASTER
    224278      call start_timer(timer_physic)
    225              
     279c$OMP END MASTER
     280
     281c$OMP MASTER             
    226282      do ig0=1,klon
    227283        i=Liste_i(ig0)
    … …  
    229285        zpsrf(ig0)=pps(i,j)
    230286      enddo
    231 
     287c$OMP END MASTER
    232288
    233289
    … …  
    243299       unskap   = 1./ kappa
    244300c
     301      print *,omp_rank,'klon--->',klon
     302c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    245303      DO l = 1, llmp1
    246304        do ig0=1,klon
    … …  
    250308        enddo
    251309      ENDDO
     310c$OMP END DO NOWAIT
    252311c
    253312c
    … …  
    255314c   43. temperature naturelle (en K) et pressions milieux couches .
    256315c   ---------------------------------------------------------------
    257 
     316c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    258317      DO l=1,llm
    259318
    … …  
    268327
    269328      ENDDO
     329c$OMP END DO NOWAIT
    270330
    271331c   43.bis traceurs
    … …  
    275335      DO iq=1,nq
    276336         iiq=niadv(iq)
     337c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    277338         DO l=1,llm
    278339           do ig0=1,klon
    … …  
    282343           enddo
    283344         ENDDO
     345c$OMP END DO NOWAIT     
    284346      ENDDO
    285347
    … …  
    287349
    288350      DO iq=1,2
     351c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    289352         DO l=1,llm
    290353           do ig0=1,klon
    … …  
    294357           enddo
    295358         ENDDO
     359c$OMP END DO NOWAIT     
    296360      ENDDO
    297361
    … …  
    302366
    303367      CALL gr_dyn_fi_p(llm,iip1,jjp1,klon,pphi,zphi)
     368
     369c$OMP MASTER
    304370      CALL gr_dyn_fi_p(1,iip1,jjp1,klon,pphis,zphis)
    305 
     371c$OMP END MASTER
     372c$OMP BARRIER
     373
     374c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    306375      DO l=1,llm
    307376         DO ig=1,klon
    … …  
    309378         ENDDO
    310379      ENDDO
    311      
     380c$OMP END DO NOWAIT     
    312381c   ....  Calcul de la vitesse  verticale  ( en Pa*m*s  ou Kg/s )  ....
    313382c
    314        
     383c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
    315384      DO l=1,llm
    316385        do ig0=1,klon
    … …  
    322391        if (pole_sud) pvervel(klon,l)=pw(1,jjp1,l)*g/apols
    323392      ENDDO
    324 
     393c$OMP END DO NOWAIT
    325394
    326395c
    … …  
    334403      if (pole_sud) kend=klon-1
    335404     
     405c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    336406      DO l=1,llm
    337407        do ig0=kstart,kend
    … …  
    351421        enddo
    352422      ENDDO
    353 
     423c$OMP END DO NOWAIT
    354424c   46.champ v:
    355425c   -----------
    356 
     426c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    357427      DO l=1,llm
    358428        DO ig0=kstart,kend
    … …  
    366436         ENDDO
    367437      ENDDO
    368 
     438c$OMP END DO NOWAIT
    369439
    370440c   47. champs de vents aux pole nord   
    … …  
    374444
    375445      if (pole_nord) then
    376      
     446c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    377447        DO l=1,llm
    378448
    … …  
    397467 
    398468        ENDDO
    399      
     469c$OMP END DO NOWAIT     
    400470      endif
    401471
    … …  
    407477
    408478      if (pole_sud) then
    409      
     479c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    410480        DO l=1,llm
    411481 
    … …  
    430500
    431501        ENDDO
    432      
     502c$OMP END DO NOWAIT      
    433503      endif
    434504
    435505
    436 #ifdef INCA_CH4
     506      IF (monocpu) THEN
     507c
     508cIM calcul PV a teta=350, 380, 405K
     509        CALL PVtheta(ngridmx,llm,pucov,pvcov,pteta,
     510     $           ztfi,zplay,zplev,
     511     $           ntetaSTD,rtetaSTD,PVteta)
     512c
     513      ENDIF
     514#ifdef INCA
    437515      CALL gr_dyn_fi_p(llm,iip1,jjp1,klon,flxw,flxwfi)
    438516#endif
    … …  
    443521c   ---------------------
    444522
    445 
     523cc$OMP  PARALLEL DEFAULT(NONE)
     524cc$OMP+ PRIVATE(i,l,offset,iq)
     525cc$OMP+ SHARED(klon_omp_nb,nq,klon_omp_begin,
     526cc$OMP+        debut,lafin,rdayvrai,heure,dtphys,zplev,zplay,
     527cc$OMP+        zphi,zphis,presnivs,clesphy0,zufi,zvfi,ztfi,
     528cc$OMP+        zqfi,pvervel,zdufi,zdvfi,zdtfi,zdqfi,zdpsrf)
     529
     530c PRIVATE(zplev_omp,zplay_omp,zphi_omp,zphis_omp,
     531c c$OMP+                 presnivs_omp,zufi_omp,zvfi_omp,ztfi_omp,
     532c c$OMP+                 zqfi_omp,pvervel_omp,zdufi_omp,zdvfi_omp,
     533c c$OMP+                 zdtfi_omp,zdqfi_omp,zdpsrf_omp)
     534
     535c$OMP BARRIER
     536      if (first_omp) then
     537        klon=klon_omp_nb(omp_rank)
     538
     539        allocate(zplev_omp(klon,llm+1))
     540        allocate(zplay_omp(klon,llm))
     541        allocate(zphi_omp(klon,llm))
     542        allocate(zphis_omp(klon))
     543        allocate(presnivs_omp(llm))
     544        allocate(zufi_omp(klon,llm))
     545        allocate(zvfi_omp(klon,llm))
     546        allocate(ztfi_omp(klon,llm))
     547        allocate(zqfi_omp(klon,llm,nq))
     548        allocate(pvervel_omp(klon,llm))
     549        allocate(zdufi_omp(klon,llm))
     550        allocate(zdvfi_omp(klon,llm))
     551        allocate(zdtfi_omp(klon,llm))
     552        allocate(zdqfi_omp(klon,llm,nq))
     553        allocate(zdpsrf_omp(klon))
     554        first_omp=.false.
     555      endif
     556       
     557           
     558      klon=klon_omp_nb(omp_rank)
     559      offset=klon_omp_begin(omp_rank)-1
     560     
     561      do l=1,llm+1
     562        do i=1,klon
     563          zplev_omp(i,l)=zplev(offset+i,l)
     564        enddo
     565      enddo
     566         
     567       do l=1,llm
     568        do i=1,klon 
     569          zplay_omp(i,l)=zplay(offset+i,l)
     570        enddo
     571      enddo
     572       
     573      do l=1,llm
     574        do i=1,klon
     575          zphi_omp(i,l)=zphi(offset+i,l)
     576        enddo
     577      enddo
     578       
     579
     580      do i=1,klon
     581        zphis_omp(i)=zphis(offset+i)
     582      enddo
     583     
     584       
     585      do l=1,llm
     586        presnivs_omp(l)=presnivs(l)
     587      enddo
     588       
     589      do l=1,llm
     590        do i=1,klon
     591          zufi_omp(i,l)=zufi(offset+i,l)
     592        enddo
     593      enddo
     594       
     595      do l=1,llm
     596        do i=1,klon
     597          zvfi_omp(i,l)=zvfi(offset+i,l)
     598        enddo
     599      enddo
     600       
     601      do l=1,llm
     602        do i=1,klon
     603          ztfi_omp(i,l)=ztfi(offset+i,l)
     604        enddo
     605      enddo
     606       
     607      do iq=1,nq
     608        do l=1,llm
     609          do i=1,klon
     610            zqfi_omp(i,l,iq)=zqfi(offset+i,l,iq)
     611          enddo
     612        enddo
     613      enddo
     614       
     615      do l=1,llm
     616        do i=1,klon
     617          pvervel_omp(i,l)=pvervel(offset+i,l)
     618        enddo
     619      enddo
     620       
     621      do l=1,llm
     622        do i=1,klon
     623          zdufi_omp(i,l)=zdufi(offset+i,l)
     624        enddo
     625      enddo
     626       
     627      do l=1,llm
     628        do i=1,klon
     629          zdvfi_omp(i,l)=zdvfi(offset+i,l)
     630        enddo
     631      enddo
     632       
     633      do l=1,llm
     634        do i=1,klon
     635          zdtfi_omp(i,l)=zdtfi(offset+i,l)
     636        enddo
     637      enddo
     638       
     639      do iq=1,nq
     640        do l=1,llm
     641          do i=1,klon
     642            zdqfi_omp(i,l,iq)=zdqfi(offset+i,l,iq)
     643          enddo
     644        enddo
     645      enddo
     646       
     647      do i=1,klon
     648        zdpsrf_omp(i)=zdpsrf(offset+i)
     649      enddo
     650     
     651c$OMP BARRIER
     652cym      call WriteField_phy_p('zdtfi_omp',zdtfi_omp(:,:),llm)
     653     
    446654      CALL physiq (klon,
    447655     .             llm,
    … …  
    452660     .             heure,
    453661     .             dtphys,
    454      .             zplev,
    455      .             zplay,
    456      .             zphi,
    457      .             zphis,
    458      .             presnivs,
     662     .             zplev_omp,
     663     .             zplay_omp,
     664     .             zphi_omp,
     665     .             zphis_omp,
     666     .             presnivs_omp,
    459667     .             clesphy0,
    460      .             zufi,
    461      .             zvfi,
    462      .             ztfi,
    463      .             zqfi,
    464      .             pvervel,
    465 #ifdef INCA_CH4
     668     .             zufi_omp,
     669     .             zvfi_omp,
     670     .             ztfi_omp,
     671     .             zqfi_omp,
     672     .             pvervel_omp,
     673#ifdef INCA
    466674     .             flxwfi,
    467675#endif
    468      .             zdufi,
    469      .             zdvfi,
    470      .             zdtfi,
    471      .             zdqfi,
    472      .             zdpsrf)
    473 
     676     .             zdufi_omp,
     677     .             zdvfi_omp,
     678     .             zdtfi_omp,
     679     .             zdqfi_omp,
     680     .             zdpsrf_omp,
     681cIM diagnostique PVteta, Amip2         
     682     .             pducov,
     683     .             PVteta)
     684
     685cym      call WriteField_phy_p('zdtfi_omp',zdtfi_omp(:,:),llm)
     686
     687c$OMP BARRIER
     688
     689      do l=1,llm+1
     690        do i=1,klon
     691          zplev(offset+i,l)=zplev_omp(i,l)
     692        enddo
     693      enddo
     694         
     695       do l=1,llm
     696        do i=1,klon 
     697          zplay(offset+i,l)=zplay_omp(i,l)
     698        enddo
     699      enddo
     700       
     701      do l=1,llm
     702        do i=1,klon
     703          zphi(offset+i,l)=zphi_omp(i,l)
     704        enddo
     705      enddo
     706       
     707
     708      do i=1,klon
     709        zphis(offset+i)=zphis_omp(i)
     710      enddo
     711     
     712       
     713      do l=1,llm
     714        presnivs(l)=presnivs_omp(l)
     715      enddo
     716       
     717      do l=1,llm
     718        do i=1,klon
     719          zufi(offset+i,l)=zufi_omp(i,l)
     720        enddo
     721      enddo
     722       
     723      do l=1,llm
     724        do i=1,klon
     725          zvfi(offset+i,l)=zvfi_omp(i,l)
     726        enddo
     727      enddo
     728       
     729      do l=1,llm
     730        do i=1,klon
     731          ztfi(offset+i,l)=ztfi_omp(i,l)
     732        enddo
     733      enddo
     734       
     735      do iq=1,nq
     736        do l=1,llm
     737          do i=1,klon
     738            zqfi(offset+i,l,iq)=zqfi_omp(i,l,iq)
     739          enddo
     740        enddo
     741      enddo
     742       
     743      do l=1,llm
     744        do i=1,klon
     745          pvervel(offset+i,l)=pvervel_omp(i,l)
     746        enddo
     747      enddo
     748       
     749      do l=1,llm
     750        do i=1,klon
     751          zdufi(offset+i,l)=zdufi_omp(i,l)
     752        enddo
     753      enddo
     754       
     755      do l=1,llm
     756        do i=1,klon
     757          zdvfi(offset+i,l)=zdvfi_omp(i,l)
     758        enddo
     759      enddo
     760       
     761      do l=1,llm
     762        do i=1,klon
     763          zdtfi(offset+i,l)=zdtfi_omp(i,l)
     764        enddo
     765      enddo
     766       
     767      do iq=1,nq
     768        do l=1,llm
     769          do i=1,klon
     770            zdqfi(offset+i,l,iq)=zdqfi_omp(i,l,iq)
     771          enddo
     772        enddo
     773      enddo
     774       
     775      do i=1,klon
     776        zdpsrf(offset+i)=zdpsrf_omp(i)
     777      enddo
     778     
     779
     780cc$OMP END PARALLEL
     781      klon=klon_mpi
    474782500   CONTINUE
    475 
     783c$OMP BARRIER
     784
     785c$OMP MASTER
     786cym      call WriteField_phy('zdtfi',zdtfi(:,:),llm)
    476787      call stop_timer(timer_physic)
     788c$OMP END MASTER
    477789     
    478790      if (MPI_rank>0) then
    479      
    480         du_send(1:iim,1:llm)=zdufi(1:iim,1:llm)
    481         dv_send(1:iim,1:llm)=zdvfi(1:iim,1:llm)
    482        
     791
     792c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
     793       DO l=1,llm     
     794        du_send(1:iim,l)=zdufi(1:iim,l)
     795        dv_send(1:iim,l)=zdvfi(1:iim,l)
     796       ENDDO
     797c$OMP END DO NOWAIT       
     798
     799c$OMP BARRIER
     800c$OMP MASTER
    483801        call MPI_ISSEND(du_send,iim*llm,MPI_REAL8,MPI_Rank-1,401,
    484      &                   MPI_COMM_WORLD,Req(1),ierr)
     802     &                   COMM_LMDZ,Req(1),ierr)
    485803        call MPI_ISSEND(dv_send,iim*llm,MPI_REAL8,MPI_Rank-1,402,
    486      &                  MPI_COMM_WORLD,Req(2),ierr)
     804     &                  COMM_LMDZ,Req(2),ierr)
     805c$OMP END MASTER
     806c$OMP BARRIER
    487807     
    488808      endif
    489809   
    490810      if (MPI_rank<MPI_Size-1) then
    491      
     811c$OMP BARRIER
     812c$OMP MASTER     
    492813        call MPI_IRECV(du_recv,iim*llm,MPI_REAL8,MPI_Rank+1,401,
    493      &                 MPI_COMM_WORLD,Req(3),ierr)
     814     &                 COMM_LMDZ,Req(3),ierr)
    494815        call MPI_IRECV(dv_recv,iim*llm,MPI_REAL8,MPI_Rank+1,402,
    495      &                 MPI_COMM_WORLD,Req(4),ierr)
    496      
     816     &                 COMM_LMDZ,Req(4),ierr)
     817c$OMP END MASTER
     818c$OMP BARRIER     
    497819      endif
    498    
     820
     821c$OMP BARRIER
     822c$OMP MASTER   
    499823      if (MPI_rank>0 .and. MPI_rank< MPI_Size-1) then
    500824        call MPI_WAITALL(4,Req(1),Status,ierr)
    … …  
    504828        call MPI_WAITALL(2,Req(3),Status,ierr)
    505829      endif
    506      
    507       zdufi2(1:klon,:)=zdufi(1:klon,:)
    508       zdufi2(klon+1:klon+iim,:)=du_recv(1:iim,:)
    509          
    510       zdvfi2(1:klon,:)=zdvfi(1:klon,:)
    511       zdvfi2(klon+1:klon+iim,:)=dv_recv(1:iim,:)
    512 
    513        pdhfi(:,jjphy_begin,:)=0
    514        pdqfi(:,jjphy_begin,:,:)=0
    515        pdufi(:,jjphy_begin,:)=0
    516        pdvfi(:,jjphy_begin,:)=0
    517        pdpsfi(:,jjphy_begin)=0
    518 
     830c$OMP END MASTER
     831c$OMP BARRIER     
     832
     833c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     834      DO l=1,llm
     835           
     836        zdufi2(1:klon,l)=zdufi(1:klon,l)
     837        zdufi2(klon+1:klon+iim,l)=du_recv(1:iim,l)
     838           
     839        zdvfi2(1:klon,l)=zdvfi(1:klon,l)
     840        zdvfi2(klon+1:klon+iim,l)=dv_recv(1:iim,l)
     841 
     842         pdhfi(:,jjphy_begin,l)=0
     843         pdqfi(:,jjphy_begin,l,:)=0
     844         pdufi(:,jjphy_begin,l)=0
     845         pdvfi(:,jjphy_begin,l)=0
     846         
     847         if (.not. pole_sud) then
     848           pdhfi(:,jjphy_end,l)=0
     849           pdqfi(:,jjphy_end,l,:)=0
     850           pdufi(:,jjphy_end,l)=0
     851           pdvfi(:,jjphy_end,l)=0
     852         endif
     853     
     854       ENDDO
     855c$OMP END DO NOWAIT
     856
     857c$OMP MASTER
     858       pdpsfi(:,jjphy_begin)=0   
    519859       if (.not. pole_sud) then
    520          pdhfi(:,jjphy_end,:)=0
    521          pdqfi(:,jjphy_end,:,:)=0
    522          pdufi(:,jjphy_end,:)=0
    523          pdvfi(:,jjphy_end,:)=0
    524860         pdpsfi(:,jjphy_end)=0
    525861       endif
    526 
     862c$OMP END MASTER
    527863c-----------------------------------------------------------------------
    528864c   transformation des tendances physiques en tendances dynamiques:
    … …  
    531867c  tendance sur la pression :
    532868c  -----------------------------------
    533 
     869c$OMP MASTER
    534870      CALL gr_fi_dyn_p(1,klon,iip1,jjp1,zdpsrf,pdpsfi)
     871c$OMP END MASTER
    535872c
    536873c   62. enthalpie potentielle
    … …  
    543880      if (pole_sud)  kend=klon-1
    544881
     882c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    545883      DO l=1,llm
    546884
    547 !cdir NODEP
     885!!cdir NODEP
    548886        do ig0=kstart,kend
    549887          i=Liste_i(ig0)
    … …  
    565903        endif
    566904      ENDDO
     905c$OMP END DO NOWAIT
    567906     
    568907c   62. humidite specifique
    … …  
    570909
    571910      DO iq=1,nqmx
     911c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    572912         DO l=1,llm
    573 !cdir NODEP
     913!!cdir NODEP
    574914           do ig0=kstart,kend
    575915             i=Liste_i(ig0)
    … …  
    592932           
    593933         ENDDO
     934c$OMP END DO NOWAIT
    594935      ENDDO
    595936
    … …  
    597938c   ------------
    598939C     initialisation des tendances
    599       pdqfi=0.
     940
     941c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     942      DO l=1,llm
     943        pdqfi(:,:,l,:)=0.
     944      ENDDO
     945c$OMP END DO NOWAIT     
     946
    600947C
    601948
    602949      DO iq=1,nq
    603950         iiq=niadv(iq)
     951c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    604952         DO l=1,llm
    605953
    606 !cdir NODEP           
     954!!cdir NODEP           
    607955             DO ig0=kstart,kend
    608956              i=Liste_i(ig0)
    … …  
    625973           
    626974         ENDDO
     975c$OMP END DO NOWAIT     
    627976      ENDDO
    628977     
    629978c   65. champ u:
    630979c   ------------
    631 
     980c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    632981      DO l=1,llm
    633 !cdir NODEP
     982!!cdir NODEP
    634983         do ig0=kstart,kend
    635984           i=Liste_i(ig0)
    … …  
    643992              pdufi(iim,j,l)=0.5*(  zdufi2(ig0,l)
    644993     $                            + zdufi2(ig0+iim-1,l))*cu(iim,j)
    645               pdufi(iip1,j,l)=0.5*(zdufi2(ig0,l)+zdufi2(ig0+1,l))*cu(i,j)
     994             pdufi(iip1,j,l)=0.5*(zdufi2(ig0,l)+zdufi2(ig0+1,l))*cu(i,j)
    646995           endif
    647996         
    … …  
    6611010         
    6621011      ENDDO
    663 
     1012c$OMP END DO NOWAIT
    6641013
    6651014c   67. champ v:
    … …  
    6721021      if (pole_sud)  kend=klon-1-iim
    6731022     
     1023c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    6741024      DO l=1,llm
    675 !cdir NODEP
     1025!!cdir NODEP
    6761026        do ig0=kstart,kend
    6771027           i=Liste_i(ig0)
    … …  
    6841034         
    6851035      ENDDO
     1036c$OMP END DO NOWAIT
    6861037
    6871038
    … …  
    6911042
    6921043      if (pole_nord) then
    693        
     1044
     1045c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    6941046        DO l=1,llm
    6951047
    … …  
    7051057
    7061058        ENDDO
     1059c$OMP END DO NOWAIT
    7071060
    7081061      endif   
    7091062     
    7101063      if (pole_sud) then
    711      
    712         DO l=1,llm
     1064
     1065c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
     1066         DO l=1,llm
    7131067 
    7141068           DO i=1,iim
    … …  
    7231077
    7241078        ENDDO
     1079c$OMP END DO NOWAIT
    7251080     
    7261081      endif

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

    r630 r764  
    215215       ENDDO
    216216
     217      deallocate(xtemp)
     218      deallocate(ytemp)
     219
    217220      RETURN
    218221      END

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

    r630 r764  
    372372       iflag_con = 2
    373373       CALL getin('iflag_con',iflag_con)
     374!
     375!Config  Key  = ip_ebil_dyn
     376!Config  Desc = PRINT level for energy conserv. diag.
     377!Config  Def  = 0
     378!Config  Help = PRINT level for energy conservation diag. ;
     379!               les options suivantes existent :
     380!Config         0 pas de print
     381!Config         1 pas de print
     382!Config         2 print,
     383       ip_ebil_dyn = 0
     384       CALL getin('ip_ebil_dyn',ip_ebil_dyn)
     385!
    374386
    375387      DO i = 1, longcles

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

    r630 r764  
    88     .              iperiod,iapp_tracvl,iconser,iecri,idissip,iphysiq ,
    99     .              periodav,ecritphy,iecrimoy,dayref,anneeref,
    10      .              raz_date,offline
     10     .              raz_date,offline,ip_ebil_dyn
    1111
    1212      INTEGER   nday,day_step,iperiod,iapp_tracvl,iconser,iecri,
    13      .          idissip,iphysiq,iecrimoy,dayref,anneeref, raz_date
     13     .          idissip,iphysiq,iecrimoy,dayref,anneeref, raz_date,
     14     .          ip_ebil_dyn
    1415      REAL periodav, ecritphy
    1516      logical offline

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

    r630 r764  
    3333c
    3434     
    35      
     35c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)         
    3636      DO 5 l = 1,nbniv
    3737c
    … …  
    8080     
    8181   5  CONTINUE
    82    
     82c$OMP END DO NOWAIT   
    8383      RETURN
    8484      END

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

    r630 r764  
    3535#include "logic.h"
    3636
    37       REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm ),convm(  ip1jmp1,llm )
     37      REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm )
     38      REAL, target :: convm(  ip1jmp1,llm )
    3839      INTEGER   l,ij
    3940
    40       EXTERNAL   filtreg_p
    41       EXTERNAL   convflu_p
     41      INTEGER ijb,ije,jjb,jje
     42 
    4243     
    43       INTEGER ijb,ije,jjb,jje
    44      
    45      
    46 
    4744c-----------------------------------------------------------------------
    4845c    ....  calcul de - (d(pbaru)/dx + d(pbarv)/dy ) ......
    … …  
    6461       ije=ij_end+iip1
    6562       if (pole_sud) ije=ij_end
     63           
    6664      DO      l      = llmm1, 1, -1
    6765        DO    ij     = ijb, ije

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

    r630 r764  
    4242        ije_v=ij_end-iip1
    4343      endif
    44      
     44
     45c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
    4546      DO 10 l = 1,klevel
    4647
    … …  
    5455
    5556  10  CONTINUE
     57c$OMP END DO NOWAIT
    5658      RETURN
    5759      END

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

    r630 r764  
    4949
    5050      REAL  SSUM
    51       EXTERNAL  gradiv ,nXgrarot,divgrad,initial0
    52       EXTERNAL  gradiv2,nXgraro2,divgrad2,SSUM
    5351      integer :: ijb,ije
    5452c-----------------------------------------------------------------------
    … …  
    5654c   ----------------
    5755
     56c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    5857      DO l=1,llm
    5958         te1dt(l) = tetaudiv(l) * dtdiss
    … …  
    6160         te3dt(l) = tetah(l)    * dtdiss
    6261      ENDDO
     62c$OMP END DO NOWAIT
    6363c      CALL initial0( ijp1llm, du )
    6464c      CALL initial0( ijmllm , dv )
    … …  
    6767      ijb=ij_begin
    6868      ije=ij_end
    69      
    70       du(ijb:ije,:)=0
    71       dh(ijb:ije,:)=0
     69
     70c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     71      DO l=1,llm
     72        du(ijb:ije,l)=0
     73        dh(ijb:ije,l)=0
     74      ENDDO
     75c$OMP END DO NOWAIT
    7276     
    7377      if (pole_sud) ije=ij_end-iip1
    74      
    75       dv(ijb:ije,:)=0
     78
     79c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     80      DO l=1,llm
     81        dv(ijb:ije,l)=0
     82      ENDDO
     83c$OMP END DO NOWAIT
    7684     
    7785c-----------------------------------------------------------------------
    … …  
    99107      if (pole_sud) ije=ij_end-iip1
    100108
     109c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    101110      DO l=1,llm
    102111         if (pole_nord) then
    … …  
    123132
    124133       ENDDO
    125 
     134c$OMP END DO NOWAIT
    126135c   calcul de la partie   n X grad ( rot ):
    127136c   ---------------------------------------
    … …  
    142151      ije=ij_end
    143152      if (pole_sud) ije=ij_end-iip1
    144      
     153
     154c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
    145155      DO l=1,llm
    146156         
    … …  
    162172     
    163173      ENDDO
     174c$OMP END DO NOWAIT
    164175
    165176c   calcul de la partie   div ( grad ):
    … …  
    172183      ijb=ij_begin
    173184      ije=ij_end
    174      
     185
     186c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    175187       DO l = 1, llm
    176188          DO ij = ijb, ije
    … …  
    178190          ENDDO
    179191       ENDDO
    180 
     192c$OMP END DO NOWAIT
    181193         CALL divgrad2_p( llm,teta, deltapres  ,niterh, gdx )
    182194      ELSE
    … …  
    190202      ije=ij_end
    191203     
     204c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    192205      DO l = 1,llm
    193206         DO ij = ijb,ije
    … …  
    195208         ENDDO
    196209      ENDDO
     210c$OMP END DO NOWAIT
    197211
    198212      RETURN

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

    r630 r764  
    4848      if (pole_nord) ijb=ij_begin+iip1
    4949      if(pole_sud)  ije=ij_end-iip1
    50      
     50
     51c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    5152      DO 10 l = 1,klevel
    5253c
    … …  
    9091       endif
    9192  10  CONTINUE
     93c$OMP END DO NOWAIT
    9294c
    9395

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

    r630 r764  
    4646      if(pole_sud)  ije=ij_end-iip1
    4747     
     48c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    4849      DO 10 l = 1,klevel
    4950c
    … …  
    8889
    8990  10  CONTINUE
     91c$OMP END DO NOWAIT
    9092c
    9193
    … …  
    9395     
    9496c
     97c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    9598        DO l = 1, klevel
    9699           DO ij = ijb,ije
    … …  
    98101          ENDDO
    99102        ENDDO
     103c$OMP END DO NOWAIT
    100104c
    101105       RETURN

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

    r630 r764  
    4545      if (pole_nord) ijb=ij_begin+iip1
    4646      if(pole_sud)  ije=ij_end-iip1
    47      
     47
     48c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
    4849      DO 10 l = 1,klevel
    4950c
    … …  
    5354     *   cuvsurcv(ij-iim) * y(ij-iim,l) - cuvsurcv(ij+1) * y(ij+1,l)
    5455        ENDDO
     56
    5557c
    5658c     ....  correction pour  div( 1,j,l)  ......
    … …  
    9294       
    9395  10    CONTINUE
     96c$OMP END DO NOWAIT
     97
    9498c
    9599        jjb=jj_begin
    … …  
    100104     
    101105c
     106c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    102107        DO l = 1, klevel
    103108           DO ij = ijb,ije
    … …  
    105110          ENDDO
    106111        ENDDO
     112c$OMP END DO NOWAIT
    107113c
    108114       RETURN

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

    r630 r764  
    1       SUBROUTINE divgrad2_p ( klevel, h, deltapres, lh, divgra )
     1      SUBROUTINE divgrad2_p ( klevel, h, deltapres, lh, divgra_out )
    22c
    33c     P. Le Van
    … …  
    2323      INTEGER klevel
    2424      REAL h( ip1jmp1,klevel ), deltapres( ip1jmp1,klevel )
    25       REAL divgra( ip1jmp1,klevel)
     25      REAL divgra_out( ip1jmp1,klevel)
     26      REAL,SAVE :: divgra( ip1jmp1,llm)
     27
    2628c
    2729c    .......    variables  locales    ..........
    … …  
    3133c    ...................................................................
    3234
    33       EXTERNAL  filtreg
    34       EXTERNAL  SCOPY,  laplacien_gam
    3535      INTEGER ijb,ije
    3636c
    … …  
    4141      ijb=ij_begin
    4242      ije=ij_end
    43       divgra(ijb:ije,1:klevel)=h(ijb:ije,1:klevel)
    44 
     43c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     44      DO l = 1, klevel
     45        divgra(ijb:ije,l)=h(ijb:ije,l)
     46      ENDDO
     47c$OMP END DO NOWAIT
    4548c
     49c$OMP BARRIER
     50c$OMP MASTER
    4651      call suspend_timer(timer_dissip)
    4752      call exchange_Hallo(divgra,ip1jmp1,llm,1,1)
    4853      call resume_timer(timer_dissip)
     54c$OMP END MASTER
     55c$OMP BARRIER
    4956      CALL laplacien_p( klevel, divgra, divgra )
    50      
     57
     58c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    5159      DO l = 1, klevel
    5260       DO ij = ijb, ije
    … …  
    5462       ENDDO
    5563      ENDDO
     64c$OMP END DO NOWAIT
     65
    5666c
     67c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    5768      DO l = 1, klevel
    5869        DO ij = ijb, ije
    … …  
    6071        ENDDO
    6172      ENDDO
     73c$OMP END DO NOWAIT
    6274   
    6375c    ........    Iteration de l'operateur  laplacien_gam    ........
    6476c
    6577      DO  iter = 1, lh - 2
     78c$OMP BARRIER
     79c$OMP MASTER
    6680       call suspend_timer(timer_dissip)
    6781       call exchange_Hallo(divgra,ip1jmp1,llm,1,1)
    6882       call resume_timer(timer_dissip)
     83c$OMP END MASTER
     84c$OMP BARRIER
    6985       CALL laplacien_gam_p ( klevel,cuvscvgam2,cvuscugam2,unsair_gam2,
    7086     *                     unsapolnga2, unsapolsga2,  divgra, divgra )
    … …  
    7288c
    7389c    ...............................................................
    74  
     90
     91c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    7592      DO l = 1, klevel
    7693        DO ij = ijb, ije
    … …  
    7895        ENDDO
    7996      ENDDO
     97c$OMP END DO NOWAIT
    8098c
     99c$OMP BARRIER
     100c$OMP MASTER
    81101      call suspend_timer(timer_dissip)
    82102      call exchange_Hallo(divgra,ip1jmp1,llm,1,1)
    83103      call resume_timer(timer_dissip)
     104c$OMP END MASTER
     105c$OMP BARRIER
     106
    84107      CALL laplacien_p ( klevel, divgra, divgra )
    85108c
     109c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    86110      DO l  = 1,klevel
    87111      DO ij = ijb,ije
    88       divgra(ij,l) =  nudivgrs * divgra(ij,l) / deltapres(ij,l)
     112      divgra_out(ij,l) =  nudivgrs * divgra(ij,l) / deltapres(ij,l)
    89113      ENDDO
    90114      ENDDO
     115c$OMP END DO NOWAIT
    91116
    92117      RETURN

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

    r630 r764  
    1       SUBROUTINE divgrad_p (klevel,h, lh, divgra )
     1      SUBROUTINE divgrad_p (klevel,h, lh, divgra_out )
    22      USE parallel
    33      USE times
    … …  
    2626c
    2727      INTEGER klevel
    28       REAL h( ip1jmp1,klevel ), divgra( ip1jmp1,klevel )
     28      REAL h( ip1jmp1,klevel ), divgra_out( ip1jmp1,klevel )
     29      REAL,SAVE :: divgra( ip1jmp1,llm )
     30
    2931c
    3032      REAL ghy(ip1jm,llm), ghx(ip1jmp1,llm)
    … …  
    3234      INTEGER  l,ij,iter,lh
    3335c
    34       EXTERNAL  filtreg
    35       EXTERNAL  SCOPY, grad, covcont, diverg
    3636      INTEGER ijb,ije,jjb,jje
    3737c
    … …  
    4141      ijb=ij_begin
    4242      ije=ij_end
    43       divgra(ijb:ije,1:klevel)=h(ijb:ije,1:klevel)
    44 
     43c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     44      DO l = 1, klevel     
     45      divgra(ijb:ije,l)=h(ijb:ije,l)
     46      ENDDO
     47c$OMP END DO NOWAIT
    4548c
    4649
    … …  
    5356
    5457c      call exchange_Hallo(divgra,ip1jmp1,llm,0,1)
    55      
     58c$OMP BARRIER
     59c$OMP MASTER     
    5660      call suspend_timer(timer_dissip)
    5761      call exchange_Hallo(divgra,ip1jmp1,llm,1,1)
    5862      call resume_timer(timer_dissip)
    59        
     63c$OMP END MASTER
     64c$OMP BARRIER       
    6065      CALL    grad_p (klevel,divgra, ghx  , ghy          )
    6166
     67c$OMP BARRIER
     68c$OMP MASTER   
    6269      call suspend_timer(timer_dissip)
    6370      call exchange_Hallo(ghy,ip1jm,llm,1,0)
    6471      call resume_timer(timer_dissip)
    65      
     72c$OMP END MASTER
     73c$OMP BARRIER           
     74
    6675      CALL  diverg_p (klevel,  ghx , ghy  , divgra       )
    6776
    … …  
    7079      CALL filtreg_p( divgra,jjb,jje,jjp1,klevel,2,1,.true.,1)
    7180
     81c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    7282      DO 5 l = 1,klevel
    7383      DO 4  ij = ijb, ije
    74       divgra( ij,l ) = - cdivh * divgra( ij,l )
     84      divgra_out( ij,l ) = - cdivh * divgra( ij,l )
    7585   4  CONTINUE
    7686   5  CONTINUE
     87c$OMP END DO NOWAIT
    7788c
    7889  10  CONTINUE

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

    r630 r764  
    3030      REAL hbyv( ip1jm,llm ), hbxu( ip1jmp1,llm )
    3131
    32       EXTERNAL     convflu_p
    33       EXTERNAL     filtreg_p
    3432c
    35 
    3633      INTEGER ijb,ije,jjb,jje
    3734
    … …  
    3936      jjb=jj_begin
    4037      jje=jj_end
    41      
     38
     39c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
    4240      DO 5 l = 1,llm
    4341     
    … …  
    7371       
    7472   5  CONTINUE
    75 
     73c$OMP END DO NOWAIT
    7674       
    7775       

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

    r630 r764  
    2626c
    2727     
    28      
     28c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)      
    2929      DO 10 l = 1,llm
    3030c
    … …  
    6060c
    6161  10  CONTINUE
     62c$OMP END DO NOWAIT
    6263      RETURN
    6364      END

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

    r630 r764  
    3232c
    3333c
     34c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    3435      DO 5 l = 1,llm
    3536c
    … …  
    6364c
    6465   5  CONTINUE
     66c$OMP END DO NOWAIT
    6567c
    6668      RETURN

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

    r630 r764  
    147147c
    148148      ierr = NF_REDEF (nid)
     149cIM 220306 BEG
     150#ifdef NC_DOUBLE
     151      ierr = NF_DEF_VAR (nid,"controle",NF_DOUBLE,1,idim_index,nvarid)
     152#else
    149153      ierr = NF_DEF_VAR (nid,"controle",NF_FLOAT,1,idim_index,nvarid)
     154#endif
     155cIM 220306 END
    150156      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
    151157     .                       "Parametres de controle")
    … …  
    158164c
    159165      ierr = NF_REDEF (nid)
     166cIM 220306 BEG
     167#ifdef NC_DOUBLE
     168      ierr = NF_DEF_VAR (nid,"rlonu",NF_DOUBLE,1,idim_rlonu,nvarid)
     169#else
    160170      ierr = NF_DEF_VAR (nid,"rlonu",NF_FLOAT,1,idim_rlonu,nvarid)
     171#endif
     172cIM 220306 END
    161173      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
    162174     .                       "Longitudes des points U")
    … …  
    169181c
    170182      ierr = NF_REDEF (nid)
     183cIM 220306 BEG
     184#ifdef NC_DOUBLE
     185      ierr = NF_DEF_VAR (nid,"rlatu",NF_DOUBLE,1,idim_rlatu,nvarid)
     186#else
    171187      ierr = NF_DEF_VAR (nid,"rlatu",NF_FLOAT,1,idim_rlatu,nvarid)
     188#endif
     189cIM 220306 END
    172190      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
    173191     .                       "Latitudes des points U")
    … …  
    180198c
    181199      ierr = NF_REDEF (nid)
     200cIM 220306 BEG
     201#ifdef NC_DOUBLE
     202      ierr = NF_DEF_VAR (nid,"rlonv",NF_DOUBLE,1,idim_rlonv,nvarid)
     203#else
    182204      ierr = NF_DEF_VAR (nid,"rlonv",NF_FLOAT,1,idim_rlonv,nvarid)
     205#endif
     206cIM 220306 END
    183207      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
    184208     .                       "Longitudes des points V")
    … …  
    191215c
    192216      ierr = NF_REDEF (nid)
     217cIM 220306 BEG
     218#ifdef NC_DOUBLE
     219      ierr = NF_DEF_VAR (nid,"rlatv",NF_DOUBLE,1,idim_rlatv,nvarid)
     220#else
    193221      ierr = NF_DEF_VAR (nid,"rlatv",NF_FLOAT,1,idim_rlatv,nvarid)
     222#endif
     223cIM 220306 END
    194224      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
    195225     .                       "Latitudes des points V")
    … …  
    202232c
    203233      ierr = NF_REDEF (nid)
     234cIM 220306 BEG
     235#ifdef NC_DOUBLE
     236      ierr = NF_DEF_VAR (nid,"nivsigs",NF_DOUBLE,1,idim_s,nvarid)
     237#else
    204238      ierr = NF_DEF_VAR (nid,"nivsigs",NF_FLOAT,1,idim_s,nvarid)
     239#endif
     240cIM 220306 END
    205241      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 28,
    206242     .                       "Numero naturel des couches s")
    … …  
    213249c
    214250      ierr = NF_REDEF (nid)
     251cIM 220306 BEG
     252#ifdef NC_DOUBLE
     253      ierr = NF_DEF_VAR (nid,"nivsig",NF_DOUBLE,1,idim_sig,nvarid)
     254#else
    215255      ierr = NF_DEF_VAR (nid,"nivsig",NF_FLOAT,1,idim_sig,nvarid)
     256#endif
     257cIM 220306 END
    216258      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 32,
    217259     .                       "Numero naturel des couches sigma")
    … …  
    224266c
    225267      ierr = NF_REDEF (nid)
     268cIM 220306 BEG
     269#ifdef NC_DOUBLE
     270      ierr = NF_DEF_VAR (nid,"ap",NF_DOUBLE,1,idim_sig,nvarid)
     271#else
    226272      ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_sig,nvarid)
     273#endif
     274cIM 220306 END
    227275      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26,
    228276     .                       "Coefficient A pour hybride")
    … …  
    235283c
    236284      ierr = NF_REDEF (nid)
     285cIM 220306 BEG
     286#ifdef NC_DOUBLE
     287      ierr = NF_DEF_VAR (nid,"bp",NF_DOUBLE,1,idim_sig,nvarid)
     288#else
    237289      ierr = NF_DEF_VAR (nid,"bp",NF_FLOAT,1,idim_sig,nvarid)
     290#endif
     291cIM 220306 END
    238292      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26,
    239293     .                       "Coefficient B pour hybride")
    … …  
    246300c
    247301      ierr = NF_REDEF (nid)
     302cIM 220306 BEG
     303#ifdef NC_DOUBLE
     304      ierr = NF_DEF_VAR (nid,"presnivs",NF_DOUBLE,1,idim_s,nvarid)
     305#else
    248306      ierr = NF_DEF_VAR (nid,"presnivs",NF_FLOAT,1,idim_s,nvarid)
     307#endif
     308cIM 220306 END
    249309      ierr = NF_ENDDEF(nid)
    250310#ifdef NC_DOUBLE
    … …  
    259319      dims2(1) = idim_rlonu
    260320      dims2(2) = idim_rlatu
     321cIM 220306 BEG
     322#ifdef NC_DOUBLE
     323      ierr = NF_DEF_VAR (nid,"cu",NF_DOUBLE,2,dims2,nvarid)
     324#else
    261325      ierr = NF_DEF_VAR (nid,"cu",NF_FLOAT,2,dims2,nvarid)
     326#endif
     327cIM 220306 END
    262328      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
    263329     .                       "Coefficient de passage pour U")
    … …  
    272338      dims2(1) = idim_rlonv
    273339      dims2(2) = idim_rlatv
     340cIM 220306 BEG
     341#ifdef NC_DOUBLE
     342      ierr = NF_DEF_VAR (nid,"cv",NF_DOUBLE,2,dims2,nvarid)
     343#else
    274344      ierr = NF_DEF_VAR (nid,"cv",NF_FLOAT,2,dims2,nvarid)
     345#endif
     346cIM 220306 END
    275347      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
    276348     .                       "Coefficient de passage pour V")
    … …  
    287359      dims2(1) = idim_rlonv
    288360      dims2(2) = idim_rlatu
     361cIM 220306 BEG
     362#ifdef NC_DOUBLE
     363      ierr = NF_DEF_VAR (nid,"aire",NF_DOUBLE,2,dims2,nvarid)
     364#else
    289365      ierr = NF_DEF_VAR (nid,"aire",NF_FLOAT,2,dims2,nvarid)
     366#endif
     367cIM 220306 END
    290368      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
    291369     .                       "Aires de chaque maille")
    … …  
    302380      dims2(1) = idim_rlonv
    303381      dims2(2) = idim_rlatu
     382cIM 220306 BEG
     383#ifdef NC_DOUBLE
     384      ierr = NF_DEF_VAR (nid,"phisinit",NF_DOUBLE,2,dims2,nvarid)
     385#else
    304386      ierr = NF_DEF_VAR (nid,"phisinit",NF_FLOAT,2,dims2,nvarid)
     387#endif
     388cIM 220306 END
    305389      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
    306390     .                       "Geopotentiel au sol")
    … …  
    316400      ierr = NF_REDEF (nid) ! entrer dans le mode de definition
    317401c
     402cIM 220306 BEG
     403#ifdef NC_DOUBLE
     404      ierr = NF_DEF_VAR (nid,"temps",NF_DOUBLE,1,idim_tim,nvarid)
     405#else
    318406      ierr = NF_DEF_VAR (nid,"temps",NF_FLOAT,1,idim_tim,nvarid)
     407#endif
     408cIM 220306 END
    319409      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
    320410     .                       "Temps de simulation")
    … …  
    329419      dims4(3) = idim_s
    330420      dims4(4) = idim_tim
     421cIM 220306 BEG
     422#ifdef NC_DOUBLE
     423      ierr = NF_DEF_VAR (nid,"ucov",NF_DOUBLE,4,dims4,nvarid)
     424#else
    331425      ierr = NF_DEF_VAR (nid,"ucov",NF_FLOAT,4,dims4,nvarid)
     426#endif
     427cIM 220306 END
    332428      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
    333429     .                       "Vitesse U")
    … …  
    337433      dims4(3) = idim_s
    338434      dims4(4) = idim_tim
     435cIM 220306 BEG
     436#ifdef NC_DOUBLE
     437      ierr = NF_DEF_VAR (nid,"vcov",NF_DOUBLE,4,dims4,nvarid)
     438#else
    339439      ierr = NF_DEF_VAR (nid,"vcov",NF_FLOAT,4,dims4,nvarid)
     440#endif
     441cIM 220306 END
    340442      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
    341443     .                       "Vitesse V")
    … …  
    345447      dims4(3) = idim_s
    346448      dims4(4) = idim_tim
     449cIM 220306 BEG
     450#ifdef NC_DOUBLE
     451      ierr = NF_DEF_VAR (nid,"teta",NF_DOUBLE,4,dims4,nvarid)
     452#else
    347453      ierr = NF_DEF_VAR (nid,"teta",NF_FLOAT,4,dims4,nvarid)
     454#endif
     455cIM 220306 END
    348456      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 11,
    349457     .                       "Temperature")
    … …  
    355463      IF(nq.GE.1) THEN
    356464      DO iq=1,nq
     465cIM 220306 BEG
     466#ifdef NC_DOUBLE
     467      ierr = NF_DEF_VAR (nid,tname(iq),NF_DOUBLE,4,dims4,nvarid)
     468#else
    357469      ierr = NF_DEF_VAR (nid,tname(iq),NF_FLOAT,4,dims4,nvarid)
     470#endif
     471cIM 220306 END
    358472      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,ttext(iq))
    359473      ENDDO
    … …  
    364478      dims4(3) = idim_s
    365479      dims4(4) = idim_tim
     480cIM 220306 BEG
     481#ifdef NC_DOUBLE
     482      ierr = NF_DEF_VAR (nid,"masse",NF_DOUBLE,4,dims4,nvarid)
     483#else
    366484      ierr = NF_DEF_VAR (nid,"masse",NF_FLOAT,4,dims4,nvarid)
     485#endif
     486cIM 220306 END
    367487      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,
    368488     .                       "C est quoi ?")
    … …  
    371491      dims3(2) = idim_rlatu
    372492      dims3(3) = idim_tim
     493cIM 220306 BEG
     494#ifdef NC_DOUBLE
     495      ierr = NF_DEF_VAR (nid,"ps",NF_DOUBLE,3,dims3,nvarid)
     496#else
    373497      ierr = NF_DEF_VAR (nid,"ps",NF_FLOAT,3,dims3,nvarid)
     498#endif
     499cIM 220306 END
    374500      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 15,
    375501     .                       "Pression au sol")
    … …  
    377503      ierr = NF_ENDDEF(nid) ! sortir du mode de definition
    378504      ierr = NF_CLOSE(nid) ! fermer le fichier
     505
    379506
    380507      PRINT*,'iim,jjm,llm,iday_end',iim,jjm,llm,iday_end

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

    r630 r764  
    5858c              0.5 * V(i,  j)**2 *( alpha2 + alpha3 )
    5959
    60 
     60c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    6161      DO 5 l = 1,llm
    6262     
    … …  
    117117     
    118118   5  CONTINUE
     119c$OMP END DO NOWAIT
    119120      RETURN
    120121      END

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

    r630 r764  
    4848      REAL xpn, xps
    4949      REAL SSUM
    50       EXTERNAL filtreg, SSUM
     50      EXTERNAL SSUM
    5151      INTEGER ije,ijb,jje,jjb
    5252c

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

    r630 r764  
    3737      REAL       SSUM
    3838     
    39      
     39c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
    4040      DO  5 l = 1,llm
    4141
    … …  
    6161
    6262   5  CONTINUE
    63 
     63c$OMP END DO NOWAIT
    6464c    ................................................................
    6565c     calcul de la composante du flux de masse en x aux poles .......
    … …  
    8787        saireun= SSUM( iim, aireu(   1     ), 1 )
    8888
     89c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
    8990        DO l = 1,llm
    9091 
    … …  
    111112       
    112113        ENDDO
    113      
     114c$OMP END DO NOWAIT             
     115
    114116      ENDIF
    115117
    … …  
    119121        saires = SSUM( iim,  aire( ip1jm+1 ), 1 )
    120122        saireus= SSUM( iim, aireu( ip1jm+1 ), 1 )
    121        
     123
     124c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
    122125        DO  l = 1,llm
    123126 
    … …  
    143146       
    144147        ENDDO
    145          
     148c$OMP END DO NOWAIT         
    146149      ENDIF
    147150     

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

    r630 r764  
    3939      real tst(1),ist(1),istp(1)
    4040      INTEGER ij,l,irec,i,j,itau
    41       INTEGER fluxid, fluxvid,fluxdid
     41      INTEGER,SAVE :: fluxid, fluxvid,fluxdid
    4242 
    4343      SAVE iadvtr, massem,pbaruc,pbarvc,irec
    … …  
    4949      integer :: ijb,ije,jjb,jje,jjn
    5050      type(Request) :: Req
     51
     52c AC initialisations
     53cym      pbarug(:,:)   = 0.
     54cym      pbarvg(:,:,:) = 0.
     55cym      wg(:,:)       = 0.
    5156
    5257      if(first) then

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

    r630 r764  
    44c
    55c
    6        SUBROUTINE fxhyp ( xzoomdeg,grossism,dzoom,tau ,
     6       SUBROUTINE fxhyp ( xzoomdeg,grossism,dzooma,tau ,
    77     , rlonm025,xprimm025,rlonv,xprimv,rlonu,xprimu,rlonp025,xprimp025,
    88     , champmin,champmax                                               )
    … …  
    3838c     ......  arguments  d'entree   .......
    3939c
    40        REAL xzoomdeg,dzoom,tau,grossism
     40       REAL xzoomdeg,dzooma,tau,grossism
    4141
    4242c    ......   arguments  de  sortie  ......
    … …  
    4747c     .... variables locales  ....
    4848c
     49       REAL   dzoom
    4950       REAL*8 xlon(iip1),xprimm(iip1),xuv
    5051       REAL*8 xtild(0:nmax2)
    … …  
    7475       WRITE(6,*) 'FXHYP scal180,decalx', scal180,decalx
    7576c
    76        IF( dzoom.LT.1.)  THEN
    77          dzoom = dzoom * depi
    78        ELSEIF( dzoom.LT. 25. ) THEN
    79          WRITE(6,*) ' Le param. dzoomy pour fxhyp est trop petit ! L aug
     77       IF( dzooma.LT.1.)  THEN
     78         dzoom = dzooma * depi
     79       ELSEIF( dzooma.LT. 25. ) THEN
     80         WRITE(6,*) ' Le param. dzoomx pour fxhyp est trop petit ! L aug
    8081     ,menter et relancer ! '
    8182         STOP 1
    8283       ELSE
    83          dzoom = dzoom * pi/180.
     84         dzoom = dzooma * pi/180.
    8485       ENDIF
    8586

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

    r630 r764  
    44c
    55c
    6        SUBROUTINE fyhyp ( yzoomdeg, grossism, dzoom,tau  , 
     6       SUBROUTINE fyhyp ( yzoomdeg, grossism, dzooma,tau  , 
    77     ,  rrlatu,yyprimu,rrlatv,yyprimv,rlatu2,yprimu2,rlatu1,yprimu1 ,
    88     ,  champmin,champmax                                            )
    … …  
    3737c     .......  arguments  d'entree    .......
    3838c
    39        REAL yzoomdeg, grossism,dzoom,tau
     39       REAL yzoomdeg, grossism,dzooma,tau
    4040c         ( rentres  par  run.def )
    4141
    … …  
    4949c
    5050     
     51       REAL   dzoom
    5152       REAL*8 ylat(jjp1), yprim(jjp1)
    5253       REAL*8 yuv
    … …  
    7879       y0       =  yzoomdeg * pi/180.
    7980
    80        IF( dzoom.LT.1.)  THEN
    81          dzoom = dzoom * pi
    82        ELSEIF( dzoom.LT. 12. ) THEN
     81       IF( dzooma.LT.1.)  THEN
     82         dzoom = dzooma * pi
     83       ELSEIF( dzooma.LT. 12. ) THEN
    8384         WRITE(6,*) ' Le param. dzoomy pour fyhyp est trop petit ! L aug
    8485     ,menter et relancer ! '
    8586         STOP 1
    8687       ELSE
    87          dzoom = dzoom * pi/180.
     88         dzoom = dzooma * pi/180.
    8889       ENDIF
    8990

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

    r630 r764  
    1414      USE mod_hallo
    1515      USE Bands
    16 #ifdef INCA
    17       USE inca_dim
    18 #endif
    1916      IMPLICIT NONE
    2017
    … …  
    6461#include "iniprint.h"
    6562#include "tracstoke.h"
    66 
     63#include "advtrac.h"
    6764
    6865      INTEGER         longcles
    … …  
    119116      REAL      d_h_vcol, d_qt, d_qw, d_ql, d_ec
    120117      CHARACTER*15 ztit
    121       INTEGER   ip_ebil_dyn  ! PRINT level for energy conserv. diag.
    122       SAVE      ip_ebil_dyn
    123       DATA      ip_ebil_dyn/0/
    124118c-jld
    125119
    … …  
    161155      dynhistave_file = 'dyn_hist_ave'
    162156
     157
     158c initialisation Anne
     159      hadv_flg(:) = 0.
     160      vadv_flg(:) = 0.
     161      conv_flg(:) = 0.
     162      pbl_flg(:)  = 0.
     163      tracnam(:)  = '        '
     164      nprath = 1
     165      nbtrac = 0
     166      mmt_adj(:,:,:,:) = 1
     167
     168
    163169c--------------------------------------------------------------------------
    164170c   Iflag_phys controle l'appel a la physique :
    … …  
    208214      call InitDimphy
    209215      call InitBands
     216      call MPI_BARRIER(COMM_LMDZ,ierr)
    210217      if (mpi_rank==0) call WriteBands
    211218      call SetDistrib(jj_Nb_Caldyn)
    … …  
    218225      enddo
    219226      call Init_Mod_hallo(MPI_Buffer)
    220 
     227c$OMP PARALLEL
     228      call init_phys_openmp
    221229      call InitComgeomphy
    222 
     230c$OMP END PARALLEL
    223231#ifdef INCA
    224       call init_inca_dim
     232      call init_const_lmdz(nbtrac,anneeref,dayref,iphysiq,day_step,nday)
     233      call init_inca_para(iim,jjm+1,klon2,phy_size,klon_para_nb)
    225234#endif
    226235
    … …  
    251260      endif
    252261
     262#ifdef INCA
     263      call init_inca_dim(klon,llm,iim,jjm,
     264     $     rlonu,rlatu,rlonv,rlatv)
     265#endif
    253266
    254267
    … …  
    362375         WRITE(lunout,*)
    363376     .           'WARNING!!! vitesse verticale nulle dans la physique'
     377
    364378         CALL iniphysiq(ngridmx,llm,daysec,day_ini,dtphys ,
    365379     ,                latfi,lonfi,airefi,zcufi,zcvfi,rad,g,r,cpp     )
     380
    366381         call_iniphys=.false.
    367382      ENDIF

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

    r630 r764  
    11      SUBROUTINE gr_dyn_fi_p(nfield,im,jm,ngrid,pdyn,pfi)
    22      USE dimphy
     3      USE PARALLEL
    34      IMPLICIT NONE
    45c=======================================================================
    … …  
    1415      REAL pfi(ngrid,nfield)
    1516
    16       INTEGER i,j,ig
     17      INTEGER i,j,ig,l
    1718
    1819c-----------------------------------------------------------------------
    … …  
    2324c   traitement des poles
    2425c   traitement des point normaux
    25 
     26c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     27      DO l=1,nfield   
    2628       DO ig=1,klon
    2729         i=Liste_i(ig)
    2830         j=Liste_j(ig)
    29          pfi(ig,1:nfield)=pdyn(i,j,1:nfield)
     31         pfi(ig,l)=pdyn(i,j,l)
    3032       ENDDO
    31 
    32 
     33      ENDDO
     34c$OMP END DO NOWAIT
    3335      RETURN
    3436      END

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

    r630 r764  
    2020c   calcul:
    2121c   -------
    22 
     22c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    2323      DO ifield=1,nfield
    2424
    … …  
    4444     
    4545      ENDDO
    46 
     46c$OMP END DO NOWAIT
    4747      RETURN
    4848      END

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

    r630 r764  
    2222c
    2323c
     24c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    2425      DO 6 l = 1,klevel
    2526c
    … …  
    4748c
    4849   6  CONTINUE
     50c$OMP END DO NOWAIT
     51
    4952      RETURN
    5053      END

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

    r630 r764  
    1       SUBROUTINE gradiv2_p(klevel, xcov, ycov, ld, gdx, gdy )
     1      SUBROUTINE gradiv2_p(klevel, xcov, ycov, ld, gdx_out, gdy_out )
    22c
    33c     P. Le Van
    … …  
    2727      INTEGER klevel
    2828      REAL  xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel )
    29       REAL   gdx( ip1jmp1,klevel ),  gdy( ip1jm,klevel )
     29      REAL,SAVE ::  gdx( ip1jmp1,llm ),  gdy( ip1jm,llm )
     30      REAL   gdx_out( ip1jmp1,klevel ), gdy_out( ip1jm,klevel )
    3031c
    3132c     ........       variables locales       .........
    3233c
    33       REAL div(ip1jmp1,llm)
     34      REAL,SAVE :: div(ip1jmp1,llm)
    3435      REAL signe, nugrads
    3536      INTEGER l,ij,iter,ld
    … …  
    3839c    ........................................................
    3940c
    40       EXTERNAL   SCOPY, divergf, grad, laplacien_gam, filtreg
    4141c
    4242c      CALL SCOPY( ip1jmp1 * klevel, xcov, 1, gdx, 1 )
    … …  
    4545      ijb=ij_begin
    4646      ije=ij_end
    47       gdx(ijb:ije,1:klevel)=xcov(ijb:ije,1:klevel)
    48 
     47     
     48c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     49      DO   l = 1, klevel
     50        gdx(ijb:ije,l)=xcov(ijb:ije,l)
     51      ENDDO
     52c$OMP END DO NOWAIT     
    4953     
    5054      ijb=ij_begin
    5155      ije=ij_end
    5256      if(pole_sud) ije=ij_end-iip1
    53       gdy(ijb:ije,1:klevel)=ycov(ijb:ije,1:klevel)
    54      
     57
     58c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
     59      DO   l = 1, klevel
     60        gdy(ijb:ije,l)=ycov(ijb:ije,l)
     61      ENDDO
     62c$OMP END DO NOWAIT
     63
     64c$OMP BARRIER
     65c$OMP MASTER     
    5566      call suspend_timer(timer_dissip)
    5667      call exchange_Hallo(gdy,ip1jm,llm,1,0)
    5768      call resume_timer(timer_dissip)
     69c$OMP END MASTER
     70c$OMP BARRIER
    5871c
    5972c
    … …  
    6780
    6881      IF( ld.GT.1 )   THEN
    69        
     82c$OMP BARRIER
     83c$OMP MASTER       
    7084        call suspend_timer(timer_dissip)
    7185        call exchange_Hallo(div,ip1jmp1,llm,1,1)
    7286        call resume_timer(timer_dissip)
    73        
     87c$OMP END MASTER       
     88c$OMP BARRIER
    7489        CALL laplacien_p ( klevel, div,  div     )
    7590
    … …  
    7893
    7994        DO iter = 1, ld -2
     95c$OMP BARRIER
     96c$OMP MASTER
    8097         call suspend_timer(timer_dissip)
    8198         call exchange_Hallo(div,ip1jmp1,llm,1,1)
    8299         call resume_timer(timer_dissip)
     100c$OMP END MASTER
     101c$OMP BARRIER
    83102         CALL laplacien_gam ( klevel,cuvscvgam1,cvuscugam1,unsair_gam1,
    84103     *                       unsapolnga1, unsapolsga1,  div, div       )
    … …  
    92111       CALL filtreg_p( div   ,jjb,jje, jjp1, klevel, 2, 1, .TRUE., 1 )
    93112c       call exchange_Hallo(div,ip1jmp1,llm,0,1)
    94        
     113c$OMP BARRIER
     114c$OMP MASTER       
    95115        call suspend_timer(timer_dissip)
    96116        call exchange_Hallo(div,ip1jmp1,llm,1,1)
    97117        call resume_timer(timer_dissip)
    98 
     118c$OMP END MASTER
     119c$OMP BARRIER
    99120c       call write_field3d_p('div4',reshape(div,(/iip1,jjp1,llm/)))
    100121       CALL  grad_p  ( klevel,  div,   gdx,  gdy             )
    … …  
    104125      ije=ij_end
    105126         
    106      
     127c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    107128       DO   l = 1, klevel
    108129         
    109130         if (pole_sud) ije=ij_end
    110131         DO  ij = ijb, ije
    111           gdx( ij,l ) = gdx( ij,l ) * nugrads
     132          gdx_out( ij,l ) = gdx( ij,l ) * nugrads
    112133         ENDDO
    113134         
    114135         if (pole_sud) ije=ij_end-iip1
    115136         DO  ij = ijb, ije
    116           gdy( ij,l ) = gdy( ij,l ) * nugrads
     137          gdy_out( ij,l ) = gdy( ij,l ) * nugrads
    117138         ENDDO
    118139       
    119140       ENDDO
     141c$OMP END DO NOWAIT
    120142c
    121143       RETURN

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

    r630 r764  
    1       SUBROUTINE gradiv_p(klevel, xcov, ycov, ld, gdx, gdy )
     1      SUBROUTINE gradiv_p(klevel, xcov, ycov, ld, gdx_out, gdy_out )
    22c
    33c    Auteur :   P. Le Van
    … …  
    2626c
    2727      REAL xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel )
    28       REAL gdx( ip1jmp1,klevel ),   gdy( ip1jm,klevel )
     28      REAL,SAVE :: gdx( ip1jmp1,llm ),   gdy( ip1jm,llm )
    2929
    30       REAL div(ip1jmp1,llm)
     30      REAL gdx_out( ip1jmp1,klevel ),   gdy_out( ip1jm,klevel )
     31
     32      REAL,SAVE ::  div(ip1jmp1,llm)
    3133
    3234      INTEGER l,ij,iter,ld
    3335c
    34       EXTERNAL   SCOPY, diverg,  grad
    35       EXTERNAL   filtreg
    3636      INTEGER ijb,ije,jjb,jje
    3737c
    … …  
    4242      ijb=ij_begin
    4343      ije=ij_end
    44       gdx(ijb:ije,1:klevel)=xcov(ijb:ije,1:klevel)
    4544
     45c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
     46      DO l = 1,klevel
     47        gdx(ijb:ije,l)=xcov(ijb:ije,l)
     48      ENDDO
     49c$OMP END DO NOWAIT
     50     
    4651      ijb=ij_begin
    4752      ije=ij_end
    4853      if(pole_sud) ije=ij_end-iip1
    49       gdy(ijb:ije,1:klevel)=ycov(ijb:ije,1:klevel)
    50      
     54
     55c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
     56      DO l = 1,klevel
     57        gdy(ijb:ije,l)=ycov(ijb:ije,l)
     58      ENDDO
     59c$OMP END DO NOWAIT
     60
    5161c
    5262      DO 10 iter = 1,ld
    53      
     63
     64c$OMP BARRIER
     65c$OMP MASTER     
    5466      call suspend_timer(timer_dissip)
    5567      call exchange_Hallo(gdy,ip1jm,llm,1,0)
    5668      call resume_timer(timer_dissip)
    57      
     69c$OMP END MASTER     
     70c$OMP BARRIER
     71
    5872      CALL  diverg_p( klevel,  gdx , gdy, div          )
    5973     
    … …  
    6377     
    6478c      call exchange_Hallo(div,ip1jmp1,llm,0,1)
    65      
     79
     80c$OMP BARRIER
     81c$OMP MASTER       
    6682      call suspend_timer(timer_dissip)
    6783      call exchange_Hallo(div,ip1jmp1,llm,1,1)
    6884      call resume_timer(timer_dissip)
     85c$OMP END MASTER
     86c$OMP BARRIER
    6987     
    7088      CALL    grad_p( klevel,  div, gdx, gdy           )
    7189c
     90
     91c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    7292      DO 5  l = 1, klevel
    7393     
    7494      if(pole_sud) ije=ij_end
    7595      DO 3 ij = ijb, ije
    76         gdx( ij,l ) = - gdx( ij,l ) * cdivu
     96        gdx_out( ij,l ) = - gdx( ij,l ) * cdivu
    7797   3  CONTINUE
    7898   
    7999      if(pole_sud) ije=ij_end-iip1
    80100      DO 4 ij = ijb, ije
    81         gdy( ij,l ) = - gdy( ij,l ) * cdivu
     101        gdy_out( ij,l ) = - gdy( ij,l ) * cdivu
    82102   4  CONTINUE
    83103
    84104   5  CONTINUE
     105c$OMP END DO NOWAIT
    85106c
    86107  10  CONTINUE

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

    r630 r764  
    33!
    44      integer nfmx,imx,jmx,lmx,nvarmx
    5       parameter(nfmx=10,imx=200,jmx=150,lmx=20,nvarmx=1000)
     5      parameter(nfmx=10,imx=200,jmx=150,lmx=200,nvarmx=1000)
    66
    77      real xd(imx,nfmx),yd(jmx,nfmx),zd(lmx,nfmx),dtime(nfmx)

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

    r630 r764  
    5353c             zval:  Minimum altitude
    5454C=======================================================================
     55
    5556      IMPLICIT INTEGER (I,J)
    5657      IMPLICIT REAL(X,Z)
    … …  
    7980      REAL x(imar+1),y(jmar),zphi(imar+1,jmar)
    8081      REAL zmea(imar+1,jmar),zstd(imar+1,jmar)
     82      REAL zmea0(imar+1,jmar) ! GK211005 (CG)
    8183      REAL zsig(imar+1,jmar),zgam(imar+1,jmar),zthe(imar+1,jmar)
    8284      REAL zpic(imar+1,jmar),zval(imar+1,jmar)
    83 c$$$ PB     integer mask(imar+1,jmar)
     85cxxx PB     integer mask(imar+1,jmar)
    8486      real mask(imar+1,jmar), mask_tmp(imar+1,jmar)
    8587      real num_tot(2200,1100),num_lan(2200,1100)
    … …  
    272274         IF (weight(ii,jj) .NE. 0.0) THEN
    273275c  Mask
    274 c$$$           if(num_lan(ii,jj)/num_tot(ii,jj).ge.0.5)then
    275 c$$$             mask(ii,jj)=1
    276 c$$$           else
    277 c$$$             mask(ii,jj)=0
    278 c$$$           ENDIF
     276cXXX           if(num_lan(ii,jj)/num_tot(ii,jj).ge.0.5)then
     277cXXX             mask(ii,jj)=1
     278cXXX           else
     279cXXX             mask(ii,jj)=0
     280cXXX           ENDIF
    279281             if (.not. masque_lu) then
    280282               mask(ii,jj) = num_lan(ii,jj)/num_tot(ii,jj)
    … …  
    309311C  FIRST FILTER, MOVING AVERAGE OVER 9 POINTS.
    310312
     313       zmea0(:,:) = zmea(:,:) ! GK211005 (CG) on sauvegarde la topo non lissee
    311314       CALL MVA9(zmea,iim+1,jjm+1)
    312315       CALL MVA9(zstd,iim+1,jjm+1)
    … …  
    316319       CALL MVA9(zxtzy,iim+1,jjm+1)
    317320       CALL MVA9(zytzy,iim+1,jjm+1)
    318 C$$$   Masque prenant en compte maximum de terre
    319 C$$$  On seuil a 10% de terre de terre car en dessous les parametres de surface n'on
    320 C$$$ pas de sens (PB)
     321CXXX   Masque prenant en compte maximum de terre
     322CXXX  On seuil a 10% de terre de terre car en dessous les parametres de surface n'on
     323CXXX pas de sens (PB)
    321324       mask_tmp= 0.0
    322325       WHERE(mask .GE. 0.1) mask_tmp = 1.
    … …  
    336339           if(abs(xm).le.xw) xm=xw*sign(1.,xm)
    337340c slope:
    338 c$$$           zsig(ii,jj)=sqrt(xq)*mask(ii,jj)
    339 c$$$c isotropy:
    340 c$$$           zgam(ii,jj)=xp/xq*mask(ii,jj)
    341 c$$$c angle theta:
    342 c$$$           zthe(ii,jj)=57.29577951*atan2(xm,xl)/2.*mask(ii,jj)
    343 c$$$           zphi(ii,jj)=zmea(ii,jj)*mask(ii,jj)
    344 c$$$           zmea(ii,jj)=zmea(ii,jj)*mask(ii,jj)
    345 c$$$           zpic(ii,jj)=zpic(ii,jj)*mask(ii,jj)
    346 c$$$           zval(ii,jj)=zval(ii,jj)*mask(ii,jj)
    347 c$$$           zstd(ii,jj)=zstd(ii,jj)*mask(ii,jj)
    348 C$$* PB modif pour maque de terre fractionnaire
     341cXXX           zsig(ii,jj)=sqrt(xq)*mask(ii,jj)
     342cXXXc isotropy:
     343cXXX           zgam(ii,jj)=xp/xq*mask(ii,jj)
     344cXXXc angle theta:
     345cXXX           zthe(ii,jj)=57.29577951*atan2(xm,xl)/2.*mask(ii,jj)
     346cXXX           zphi(ii,jj)=zmea(ii,jj)*mask(ii,jj)
     347cXXX           zmea(ii,jj)=zmea(ii,jj)*mask(ii,jj)
     348cXXX           zpic(ii,jj)=zpic(ii,jj)*mask(ii,jj)
     349cXXX           zval(ii,jj)=zval(ii,jj)*mask(ii,jj)
     350cXXX           zstd(ii,jj)=zstd(ii,jj)*mask(ii,jj)
     351CXX* PB modif pour maque de terre fractionnaire
    349352c slope:
    350353           zsig(ii,jj)=sqrt(xq)*mask_tmp(ii,jj)
    … …  
    353356c angle theta:
    354357           zthe(ii,jj)=57.29577951*atan2(xm,xl)/2.*mask_tmp(ii,jj)
    355            zphi(ii,jj)=zmea(ii,jj)*mask_tmp(ii,jj)
     358           ! GK211005 (CG) ne pas forcement lisser la topo
     359           ! zphi(ii,jj)=zmea(ii,jj)*mask_tmp(ii,jj)
     360           zphi(ii,jj)=zmea0(ii,jj)*mask_tmp(ii,jj)
     361           !
    356362           zmea(ii,jj)=zmea(ii,jj)*mask_tmp(ii,jj)
    357363           zpic(ii,jj)=zpic(ii,jj)*mask_tmp(ii,jj)

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

    r630 r764  
    7373
    7474      do i=1,iip1
    75          rlonudeg(i)=rlonu(i)*180./pi
    76          rlonvdeg(i)=rlonv(i)*180./pi
     75         rlonudeg(i)=rlonu(i)*180./pi + 360.
     76         rlonvdeg(i)=rlonv(i)*180./pi + 360.
    7777      enddo
    7878

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

    r630 r764  
    3030      real wm(iip1,jjp1,llm)
    3131
    32       real zconvm(iip1,jjp1,llm),zconvmm(iip1,jjp1,llm)
     32      real,save :: zconvm(iip1,jjp1,llm)
     33      real,save :: zconvmm(iip1,jjp1,llm)
    3334
    3435      real uu
    … …  
    3839      logical firstcall
    3940      save firstcall
     41c$OMP THREADPRIVATE(firstcall)
    4042
    4143      data firstcall/.true./
    … …  
    5759      jjb=jj_begin
    5860      jje=jj_end
    59       zconvmm(:,jjb:jje,:)=zconvm(:,jjb:jje,:)
     61
     62c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
     63      do l=1,llm
     64        zconvmm(:,jjb:jje,l)=zconvm(:,jjb:jje,l)
     65      enddo
     66c$OMP END DO NOWAIT
     67
    6068      call groupeun_p(jjp1,llm,jjb,jje,zconvmm)
    6169     
    … …  
    6472      if (pole_nord) jjb=jj_begin
    6573      if (pole_sud)  jje=jj_end-1
    66       pbarvm(:,jjb:jje,:)=pbarv(:,jjb:jje,:)
     74c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
     75      do l=1,llm
     76        pbarvm(:,jjb:jje,l)=pbarv(:,jjb:jje,l)
     77      enddo
     78c$OMP END DO NOWAIT
     79
    6780      call groupeun_p(jjm,llm,jjb,jje,pbarvm)
    6881
    … …  
    7487      if (pole_sud)  jje=jj_end-1
    7588     
     89c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    7690      do l=1,llm
    7791         do j=jjb,jje
    … …  
    86100         enddo
    87101      enddo
    88 
     102c$OMP END DO NOWAIT
    89103c    integration de la convergence de masse de haut  en bas ......
    90104   
    91105      jjb=jj_begin
    92106      jje=jj_end
    93      
    94       do l=1,llm
    95          do j=jjb,jje
    96             do i=1,iip1
    97                zconvmm(i,j,l)=zconvmm(i,j,l)
    98             enddo
    99          enddo
    100       enddo
    101      
     107
     108c$OMP BARRIER
     109c$OMP MASTER     
    102110      do  l = llm-1,1,-1
    103111          do j=jjb,jje
    … …  
    107115          enddo
    108116      enddo
    109      
     117
    110118      if (.not. pole_sud) then
    111119        zconvmm(:,jj_end+1,:)=0
    112         wm(:,jj_end+1,:)=0
     120cym     wm(:,jj_end+1,:)=0
    113121      endif
     122     
     123c$OMP END MASTER
     124c$OMP BARRIER     
     125
    114126      CALL vitvert_p(zconvmm(1,1,1),wm(1,1,1))
    115127

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

    r630 r764  
    2121Champs 3D
    2222      jd=jjp1-jjmax
     23c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    2324      do l=1,llm
    2425      j1=1+jd
    … …  
    7273      enddo
    7374      enddo
    74 
     75c$OMP END DO NOWAIT
    7576      return
    7677      end

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

    r630 r764  
    8282      INTEGER step_rea,count_no_rea
    8383
    84       real aire_min,aire_max
     84c      real aire_min,aire_max
    8585      integer ilon,ilat
    8686      real factt,ztau(ip1jmp1)
    8787
    8888      INTEGER itau,ij,l,i,j
    89       integer ncidt,varidpl,nlev,status
     89      integer ncidpl,varidpl,nlev,status
    9090      integer rcod,rid
    9191      real ditau,tau,a
    … …  
    218218         step_rea=1
    219219         count_no_rea=0
    220 
     220         ncidpl=-99
    221221c    itau_test    montre si l'importation a deja ete faite au rang itau
    222222c lecture d'un fichier netcdf pour determiner le nombre de niveaux
    223          if (mpi_rank==0) then
    224          ncidt=NCOPN('T.nc',NCNOWRIT,rcod)
     223         IF (mpi_rank==0) THEN
     224       
     225         if (guide_u) then
     226           if (ncidpl.eq.-99) ncidpl=NCOPN('u.nc',NCNOWRIT,rcod)
     227         endif
     228c
     229         if (guide_v) then
     230           if (ncidpl.eq.-99) ncidpl=NCOPN('v.nc',NCNOWRIT,rcod)
     231         endif
     232c
     233         if (guide_T) then
     234           if (ncidpl.eq.-99) ncidpl=NCOPN('T.nc',NCNOWRIT,rcod)
     235         endif
     236c
     237         if (guide_Q) then
     238           if (ncidpl.eq.-99) ncidpl=NCOPN('hur.nc',NCNOWRIT,rcod)
     239         endif
     240c
    225241         if (ncep) then
    226           status=NF_INQ_DIMID(ncidt,'LEVEL',rid)
     242          status=NF_INQ_DIMID(ncidpl,'LEVEL',rid)
    227243         else
    228           status=NF_INQ_DIMID(ncidt,'PRESSURE',rid)
    229          endif
    230           status=NF_INQ_DIMLEN(ncidt,rid,nlev)
     244          status=NF_INQ_DIMID(ncidpl,'PRESSURE',rid)
     245         endif
     246          status=NF_INQ_DIMLEN(ncidpl,rid,nlev)
    231247         print *,'nlev', nlev
    232           call ncclos(ncidt,rcod)
    233          endif
     248          call ncclos(ncidpl,rcod)
     249         
     250         ENDIF
    234251         
    235252c   Lecture du premier etat des reanalyses.
    … …  
    338355      tau=tau-aint(tau)
    339356
    340       print*,'ATTENTION !!!! ON NE GUIDE QUE JUSQU A 15N'
    341 
    342357c  ucov
    343358      ijb=ij_begin
    … …  
    532547               zlat=rlatv(j)*180./pi
    533548            endif
     549          if (abs(grossismx-1.).lt.0.1.or.abs(grossismy-1.).lt.0.1) then
     550c  pour une grille reguliere, xi=xxx**0=1 -> alpha=alphamin
     551             alpha(i,j)=alphamin
     552          else
    534553            xi=((dxdy_max-dxdy_)/(dxdy_max-dxdy_min))**gamma
    535 c  pour une grille reguliere, xi=xxx**0=1 -> alpha=alphamin
    536554            xi=min(xi,1.)
    537555            if(lat_min_guide.le.zlat .and. zlat.le.lat_max_guide) then
    … …  
    540558               alpha(i,j)=0.
    541559            endif
     560          endif
    542561         enddo
    543562      enddo

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

    r630 r764  
    66      subroutine iniadvtrac(nq)
    77      USE ioipsl
    8 #ifdef INCA
    9       USE transport_controls, only : hadv_flg, vadv_flg
    10 cym      USE chemshut
    11       USE species_names
    12 #endif
    138      IMPLICIT NONE
    149c=======================================================================
    … …  
    6055      descrq(30)='PRA'
    6156
     57#ifdef INCA
     58
     59      CALL init_transport(
     60     $     hadv_flg,
     61     $     vadv_flg,
     62     $     conv_flg,
     63     $     pbl_flg,
     64     $     tracnam)
     65#endif
     66
    6267c-----------------------------------------------------------------------
    6368c        Choix  des schemas d'advection pour l'eau et les traceurs
    … …  
    110115      tnom(2)='H2Ol'
    111116      nq=nbtrac+2
     117     
    112118       if (nq.gt.nqmx) then
    113        print*,'nombre de traceurs incompatible INCA/LMDZT'
     119       print*,'nombre de traceurs incompatible INCA/LMDZT', nq, nbtrac
    114120       stop
    115121       endif
    … …  
    193199         str1=tnom(iq)
    194200         tname(iiq)=tnom(iq)
    195          ttext(iiq)=str1(1:lnblnk(str1))//descrq(iadv(iiq))
     201         IF (iadv(iiq).eq.0) THEN
     202           ttext(iiq)=str1(1:lnblnk(str1))
     203         ELSE
     204           ttext(iiq)=str1(1:lnblnk(str1))//descrq(iadv(iiq))
     205         ENDIF
    196206         str2=ttext(iiq)
    197207c   schemas tenant compte des moments d'ordre superieur.

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

    r630 r764  
    44      SUBROUTINE integrd_p
    55     $  (  nq,vcovm1,ucovm1,tetam1,psm1,massem1,
    6      $     dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis,finvmaold )
     6     $     dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps0,masse,phis,finvmaold)
    77      USE parallel
    88      IMPLICIT NONE
    … …  
    4141      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
    4242      REAL q(ip1jmp1,llm,nq)
    43       REAL ps(ip1jmp1),masse(ip1jmp1,llm),phis(ip1jmp1)
     43      REAL ps0(ip1jmp1),masse(ip1jmp1,llm),phis(ip1jmp1)
    4444
    4545      REAL vcovm1(ip1jm,llm),ucovm1(ip1jmp1,llm)
    … …  
    5555      REAL vscr( ip1jm ),uscr( ip1jmp1 ),hscr( ip1jmp1 ),pscr(ip1jmp1)
    5656      REAL massescr( ip1jmp1,llm ), finvmasse(ip1jmp1,llm)
    57       REAL p(ip1jmp1,llmp1)
     57      REAL,SAVE :: p(ip1jmp1,llmp1)
    5858      REAL tpn,tps,tppn(iim),tpps(iim)
    5959      REAL qpn,qps,qppn(iim),qpps(iim)
    … …  
    6262      INTEGER  l,ij,iq
    6363
    64       EXTERNAL  filtreg,massdair,pression
    65       EXTERNAL  SCOPY
    6664      REAL SSUM
    6765      EXTERNAL SSUM
    6866      INTEGER ijb,ije,jjb,jje
     67      REAL,SAVE :: ps(ip1jmp1)
    6968c-----------------------------------------------------------------------
     69     
    7070      if (pole_nord) THEN
    71      
     71c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    7272        DO  l = 1,llm
    7373          DO  ij = 1,iip1
    … …  
    7676           ENDDO
    7777        ENDDO
    78      
     78c$OMP END DO NOWAIT       
    7979      ENDIF
    8080
    8181      if (pole_sud) THEN
    82      
     82c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    8383        DO  l = 1,llm
    8484          DO  ij = 1,iip1
    … …  
    8787          ENDDO
    8888        ENDDO
    89      
     89c$OMP END DO NOWAIT     
    9090      ENDIF
    9191
    … …  
    9696      ijb=ij_begin
    9797      ije=ij_end
    98       massescr(ijb:ije,:)=masse(ijb:ije,:)
    99      
     98c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     99      DO  l = 1,llm
     100        massescr(ijb:ije,l)=masse(ijb:ije,l)
     101      ENDDO
     102c$OMP END DO NOWAIT
     103
     104c$OMP MASTER     
    100105      DO 2 ij = ijb,ije
    101        pscr (ij)    = ps(ij)
     106       pscr (ij)    = ps0(ij)
    102107       ps (ij)      = psm1(ij) + dt * dp(ij)
    103108   2  CONTINUE
    … …  
    133138     
    134139      ENDIF
     140c$OMP END MASTER
     141c$OMP BARRIER
    135142c
    136143c  ... Calcul  de la nouvelle masse d'air au dernier temps integre t+1 ...
    137144c
     145
    138146      CALL pression_p ( ip1jmp1, ap, bp, ps, p )
     147c$OMP BARRIER
    139148      CALL massdair_p (     p  , masse         )
    140149
    … …  
    142151      ijb=ij_begin
    143152      ije=ij_end
    144       finvmasse(ijb:ije,:)=masse(ijb:ije,:)
     153     
     154c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     155      DO  l = 1,llm
     156        finvmasse(ijb:ije,l)=masse(ijb:ije,l)
     157      ENDDO
     158c$OMP END DO NOWAIT
    145159
    146160      jjb=jj_begin
    … …  
    151165c    ............   integration  de  ucov, vcov,  h     ..............
    152166
     167c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    153168      DO 10 l = 1,llm
    154169     
    … …  
    225240
    226241  10  CONTINUE
    227 
     242c$OMP END DO NOWAIT
    228243
    229244c
    … …  
    233248      ije=ij_end
    234249     
    235 
     250c$OMP MASTER
    236251         DO l = 1, llm
    237252          DO ij = ijb, ije
    … …  
    282297     
    283298      ENDIF
     299     
     300c$OMP END MASTER
     301c$OMP BARRIER
    284302
    285303c         CALL  SCOPY( ijp1llm , finvmasse, 1, finvmaold, 1 )
    286      
    287       finvmaold(ijb:ije,:)=finvmasse(ijb:ije,:)       
     304
     305c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     306      DO l = 1, llm     
     307        finvmaold(ijb:ije,l)=finvmasse(ijb:ije,l)       
     308      ENDDO
     309c$OMP END DO NOWAIT
    288310c
    289311c
    … …  
    29231415    continue
    293315
     316c$OMP MASTER
     317        ps0(ijb:ije)=ps(ijb:ije)
     318c$OMP END MASTER
    294319c    .................................................................
    295320
    … …  
    298323c       CALL SCOPY (    ip1jmp1 ,  pscr   , 1,   psm1  , 1 )
    299324c       CALL SCOPY ( ip1jmp1*llm, massescr, 1,  massem1, 1 )
     325c$OMP MASTER
    300326        psm1(ijb:ije)=pscr(ijb:ije)
    301         massem1(ijb:ije,:)=massescr(ijb:ije,:)
     327c$OMP END MASTER
     328
     329c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     330          DO l = 1, llm
     331            massem1(ijb:ije,l)=massescr(ijb:ije,l)
     332          ENDDO
     333c$OMP END DO NOWAIT       
    302334      END IF
    303335

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

    r630 r764  
    3131c    ......................................................
    3232
    33       EXTERNAL  filtreg
    34       EXTERNAL  SCOPY, grad, divergst
    3533      INTEGER :: ijb,ije
    36      
     34      INTEGER :: l     
    3735c
    3836c
    … …  
    4947      if (pole_sud ) ije=ij_end
    5048     
    51       divgra(ijb:ije,klevel)=teta(ijb:ije,klevel)
     49c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     50      DO l=1,klevel     
     51        divgra(ijb:ije,l)=teta(ijb:ije,l)
     52      ENDDO
     53c$OMP END DO NOWAIT
     54
    5255c
    5356      CALL   grad_p ( klevel, divgra, ghx, ghy )

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

    r630 r764  
    2121      INTEGER klevel
    2222      REAL teta( ip1jmp1,klevel ), divgra( ip1jmp1,klevel )
     23      INTEGER :: l
    2324c
    2425c    ............     variables  locales      ..............
    … …  
    2728c    .......................................................
    2829
    29       EXTERNAL  SCOPY, grad, divergf, filtreg
    3030     
    3131      INTEGER :: ijb,ije,jjb,jje
    … …  
    3737      if (pole_nord) ijb=ij_begin
    3838      if (pole_sud ) ije=ij_end
    39      
    40       divgra(ijb:ije,klevel)=teta(ijb:ije,klevel)
     39
     40c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     41      DO l=1,klevel     
     42        divgra(ijb:ije,l)=teta(ijb:ije,l)
     43      ENDDO
     44c$OMP END DO NOWAIT
    4145     
    4246      jjb=jj_begin-1

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

    r630 r764  
    2828c   ........................................................
    2929c
    30       EXTERNAL  filtreg, nxgrad, rotatf
    3130c
    3231      INTEGER :: ijb,ije,jjb,jje

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

    r630 r764  
    2828c   ........................................................
    2929c
    30       EXTERNAL   nxgrad_gam, rotat_nfil
    3130      INTEGER :: ijb,ije
    3231     
    … …  
    3938      ije=ij_end
    4039      if(pole_sud) ije=ij_end-iip1
    41      
     40c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    4241      DO l = 1, klevel
    4342        DO ij = ijb, ije
    … …  
    4544        ENDDO
    4645      ENDDO
    47 
     46c$OMP END DO NOWAIT
    4847      RETURN
    4948      END

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

    r630 r764  
    1 !
     1! 
    22! $Header$
    33!
    … …  
    66#define IO_DEBUG
    77
    8 #undef CPP_IOIPSL
     8!#undef CPP_IOIPSL
    99
    1010      SUBROUTINE leapfrog_p(ucov,vcov,teta,ps,masse,phis,nq,q,clesphy0,
    … …  
    1919       USE Write_Field_p
    2020       USE vampir
    21        
    22 #ifdef INCA
    23       USE transport_controls, ONLY : hadv_flg, mmt_adj
    24 #endif
    2521
    2622      IMPLICIT NONE
    … …  
    7571
    7672#include "academic.h"
     73#include "clesphys.h"
     74#include "advtrac.h"
    7775     
    7876      include 'mpif.h'
    … …  
    146144
    147145      REAL alpha(ip1jmp1,llm),beta(ip1jmp1,llm)
    148 #ifdef INCA_CH4
     146#ifdef INCA
    149147      REAL :: flxw(ip1jmp1,llm)
    150148#endif
    … …  
    160158      REAL      d_h_vcol, d_qt, d_qw, d_ql, d_ec
    161159      CHARACTER*15 ztit
    162       INTEGER   ip_ebil_dyn  ! PRINT level for energy conserv. diag.
    163       SAVE      ip_ebil_dyn
    164       DATA      ip_ebil_dyn/0/
     160!      INTEGER   ip_ebil_dyn  ! PRINT level for energy conserv. diag.
     161!      SAVE      ip_ebil_dyn
     162!      DATA      ip_ebil_dyn/0/
    165163c-jld
    166164
    … …  
    183181      PARAMETER (testita = 9)
    184182     
    185 c declaration liées au parallelisme
     183c declaration liees au parallelisme
    186184      INTEGER :: ierr
    187185      LOGICAL :: FirstCaldyn=.TRUE.
    … …  
    198196      INTEGER :: iapptrac = 0
    199197      INTEGER :: AdjustCount = 0
    200      
     198      INTEGER :: var_time
    201199      ItCount=0
    202200     
    … …  
    225223c   Debut de l'integration temporelle:
    226224c   ----------------------------------
    227 c et du parallélisme !!
     225c et du parallelisme !!
    228226
    229227   1  CONTINUE
    230228
    231       call MPI_BARRIER(MPI_COMM_WORLD,ierr)
     229      call MPI_BARRIER(COMM_LMDZ,ierr)
    232230
    233231#ifdef CPP_IOIPSL
    234232      if (ok_guide.and.(itaufin-itau-1)*dtvr.gt.21600) then
    235         call guide(itau,ucov,vcov,teta,q,masse,ps)
     233        call guide_pp(itau,ucov,vcov,teta,q,masse,ps)
    236234      else
    237235        IF(prt_level>9)WRITE(*,*)'attention on ne guide pas les ',
    … …  
    289287cym      CALL filtreg ( finvmaold ,jjp1, llm, -2,2, .TRUE., 1 )
    290288
    291 cym  ne sert à rien
     289cym  ne sert a rien
    292290cym      call minmax(ijp1llm,q(:,:,3),zqmin,zqmax)
    293291
    … …  
    295293
    296294      ItCount=ItCount+1
    297       if (MOD(ItCount,10000)==0) then
     295      if (MOD(ItCount,1)==1) then
    298296        debug=.true.
    299297      else
    … …  
    315313      conser = .FALSE.
    316314      apdiss = .FALSE.
    317 
     315c      idissip=1
    318316      IF( purmats ) THEN
    319317         IF( MOD(itau,iconser) .EQ.0.AND.  forward    ) conser = .TRUE.
    … …  
    420418     &                                jj_Nb_caldyn,0,0,TestRequest)
    421419 
     420        do j=1,nqmx
     421         call Register_SwapFieldHallo(q(1,1,j),q(1,1,j),ip1jmp1,llm,
     422     &                                jj_nb_caldyn,0,0,TestRequest)
     423        enddo
     424
    422425         call SetDistrib(jj_nb_caldyn)
    423426         call SendRequest(TestRequest)
    … …  
    469472       call VTe(VThallo)
    470473
     474     
    471475      if (debug) then   
    472              
    473476        call WriteField_p('ucov',reshape(ucov,(/iip1,jmp1,llm/)))
    474477        call WriteField_p('vcov',reshape(vcov,(/iip1,jjm,llm/)))
    … …  
    476479        call WriteField_p('ps',reshape(ps,(/iip1,jmp1/)))
    477480        call WriteField_p('masse',reshape(masse,(/iip1,jmp1,llm/)))
     481        call WriteField_p('pk',reshape(pk,(/iip1,jmp1,llm/)))
    478482        call WriteField_p('pks',reshape(pks,(/iip1,jmp1/)))
    479483        call WriteField_p('pkf',reshape(pkf,(/iip1,jmp1,llm/)))
    480484        call WriteField_p('phis',reshape(phis,(/iip1,jmp1/)))
    481 c        do j=1,nqmx
    482 c          call WriteField_p('q'//trim(int2str(j)),
    483 c     .                reshape(q(:,:,j),(/iip1,jmp1,llm/)))
    484 c        enddo       
     485        do j=1,nqmx
     486          call WriteField_p('q'//trim(int2str(j)),
     487     .                reshape(q(:,:,j),(/iip1,jmp1,llm/)))
     488        enddo       
    485489      endif
    486       
     490 
    487491
    488492     
    … …  
    497501     
    498502      call VTb(VTcaldyn)
    499      
     503
     504      var_time=time+iday-day_ini
     505      OMP_CHUNK=5
     506c$OMP PARALLEL DEFAULT(SHARED)
     507cc$OMP+         SHARED(itau,ucov,vcov,teta,ps,masse,pk,pkf,phis ,
     508cc$OMP+                phi,conser,du,dv,dteta,dp,w, pbaru,pbarv,
     509cc$OMP+                var_time)     
     510
    500511      CALL caldyn_p
    501512     $  ( itau,ucov,vcov,teta,ps,masse,pk,pkf,phis ,
    502513     $    phi,conser,du,dv,dteta,dp,w, pbaru,pbarv, time+iday-day_ini )
    503      
     514
     515c$OMP END PARALLEL     
    504516      call VTe(VTcaldyn)
    505517c      call WriteField_p('du',reshape(du,(/iip1,jmp1,llm/)))
    … …  
    516528
    517529      IF( forward. OR . leapf )  THEN
    518 
    519 c
    520 #ifdef INCA_CH4
     530c$OMP PARALLEL DEFAULT(SHARED)
     531c
     532#ifdef INCA
    521533             CALL caladvtrac_p(q,pbaru,pbarv,
    522534     *                      p, masse, dq,  teta,
    523535     .             flxw,
    524      .             pk,
    525      .             mmt_adj,
    526      .             hadv_flg,iapptrac)
     536     .             pk,
     537     .             iapptrac)
    527538#else
    528539             CALL caladvtrac_p(q,pbaru,pbarv,
    … …  
    530541     .             pk,iapptrac)
    531542#endif
     543
     544c$OMP END PARALLEL
     545
    532546c      do j=1,nqmx
    533547c        call WriteField_p('q'//trim(int2str(j)),
    534 c    .                reshape(q(:,:,j),(/iip1,jmp1,llm/)))
     548c     .                reshape(q(:,:,j),(/iip1,jmp1,llm/)))
    535549c        call WriteField_p('dq'//trim(int2str(j)),
    536550c     .                reshape(dq(:,:,j),(/iip1,jmp1,llm/)))
    537551c      enddo
    538 
    539          IF (offline) THEN
     552       IF (offline) THEN
    540553Cmaf stokage du flux de masse pour traceurs OFF-LINE
    541 
     554#undef CPP_IOIPSL
    542555#ifdef CPP_IOIPSL
    543556           CALL fluxstokenc(pbaru,pbarv,masse,teta,phi,phis,
    … …  
    556569 
    557570       call VTb(VTintegre)
     571c      call WriteField_p('ucovm1',reshape(ucovm1,(/iip1,jmp1,llm/)))
     572c      call WriteField_p('vcovm1',reshape(vcovm1,(/iip1,jjm,llm/)))
     573c      call WriteField_p('tetam1',reshape(tetam1,(/iip1,jmp1,llm/)))
     574c      call WriteField_p('psm1',reshape(psm1,(/iip1,jmp1/)))
     575c      call WriteField_p('ucov',reshape(ucov,(/iip1,jmp1,llm/)))
     576c      call WriteField_p('vcov',reshape(vcov,(/iip1,jjm,llm/)))
     577c      call WriteField_p('teta',reshape(teta,(/iip1,jmp1,llm/)))
     578c      call WriteField_p('ps',reshape(ps,(/iip1,jmp1/)))
     579c$OMP PARALLEL DEFAULT(SHARED)
    558580       CALL integrd_p ( 2,vcovm1,ucovm1,tetam1,psm1,massem1 ,
    559581     $         dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis ,
    560582     $              finvmaold                                    )
    561583
     584c$OMP END PARALLEL
     585c      call WriteField_p('ucovm1',reshape(ucovm1,(/iip1,jmp1,llm/)))
     586c      call WriteField_p('vcovm1',reshape(vcovm1,(/iip1,jjm,llm/)))
     587c      call WriteField_p('tetam1',reshape(tetam1,(/iip1,jmp1,llm/)))
     588c      call WriteField_p('psm1',reshape(psm1,(/iip1,jmp1/)))
     589c      call WriteField_p('ucov',reshape(ucov,(/iip1,jmp1,llm/)))
     590c      call WriteField_p('vcov',reshape(vcov,(/iip1,jjm,llm/)))
     591c      call WriteField_p('teta',reshape(teta,(/iip1,jmp1,llm/)))
     592c      call WriteField_p('dteta',reshape(dteta,(/iip1,jmp1,llm/)))
     593
     594c      call WriteField_p('ps',reshape(ps,(/iip1,jmp1/)))
     595 
    562596       call VTe(VTintegre)
     597
    563598c .P.Le Van (26/04/94  ajout de  finvpold dans l'appel d'integrd)
    564599c
    … …  
    579614c     .......   Ajout   P.Le Van ( 17/04/96 )   ...........
    580615c
     616c$OMP PARALLEL DEFAULT(SHARED)
     617c$OMP+         PRIVATE(rdaym_ini,rdayvrai,ijb,ije)
     618
     619c$OMP MASTER
    581620         call suspend_timer(timer_caldyn)
    582621         print*,'Entree dans la physique : Iteration No ',true_itau
     622c$OMP END MASTER
     623
    583624         CALL pression_p (  ip1jmp1, ap, bp, ps,  p      )
     625c$OMP BARRIER
     626
     627c$OMP MASTER
    584628         CALL exner_hyb_p(  ip1jmp1, ps, p,alpha,beta,pks, pk, pkf )
    585 
     629c$OMP END MASTER
     630c$OMP BARRIER
    586631           rdaym_ini  = itau * dtvr / daysec
    587632           rdayvrai   = rdaym_ini  + day_ini
    … …  
    598643c+jld
    599644
    600 c  Diagnostique de conservation de l'énergie : initialisation
     645c  Diagnostique de conservation de l'energie : initialisation
    601646      IF (ip_ebil_dyn.ge.1 ) THEN
    602647          ztit='bil dyn'
    … …  
    605650      ENDIF
    606651c-jld
     652c$OMP BARRIER
     653c$OMP MASTER
    607654        call VTb(VThallo)
    608655        call SetTag(Request_physic,800)
    … …  
    638685     *                               jj_Nb_physic,2,2,Request_physic)
    639686        enddo
    640 #ifdef INCA_CH4
     687#ifdef INCA
    641688        call Register_SwapFieldHallo(flxw,flxw,ip1jmp1,llm,
    642689     *                               jj_Nb_physic,2,2,Request_physic)
    … …  
    650697       
    651698        call VTb(VTphysiq)
     699c$OMP END MASTER
     700c$OMP BARRIER
     701
     702cc$OMP MASTER   
     703c      call WriteField_p('ucovfi',reshape(ucov,(/iip1,jmp1,llm/)))
     704c      call WriteField_p('vcovfi',reshape(vcov,(/iip1,jjm,llm/)))
     705c      call WriteField_p('tetafi',reshape(teta,(/iip1,jmp1,llm/)))
     706c      call WriteField_p('pfi',reshape(p,(/iip1,jmp1,llmp1/)))
     707c      call WriteField_p('pkfi',reshape(pk,(/iip1,jmp1,llm/)))
     708cc$OMP END MASTER
     709cc$OMP BARRIER
     710       
    652711        CALL calfis_p( nq, lafin ,rdayvrai,time  ,
    653712     $               ucov,vcov,teta,q,masse,ps,p,pk,phis,phi ,
    654713     $               du,dv,dteta,dq,w,
    655 #ifdef INCA_CH4
     714#ifdef INCA
    656715     $               flxw,
    657716#endif
    658717     $               clesphy0, dufi,dvfi,dtetafi,dqfi,dpfi  )
    659      
    660718        ijb=ij_begin
    661719        ije=ij_end 
    662720        if ( .not. pole_nord) then
    663           dufi_tmp(1:iip1,:)   = dufi(ijb:ijb+iim,:)
    664           dvfi_tmp(1:iip1,:)   = dvfi(ijb:ijb+iim,:) 
    665           dtetafi_tmp(1:iip1,:)= dtetafi(ijb:ijb+iim,:) 
     721c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     722          DO l=1,llm
     723          dufi_tmp(1:iip1,l)   = dufi(ijb:ijb+iim,l)
     724          dvfi_tmp(1:iip1,l)   = dvfi(ijb:ijb+iim,l) 
     725          dtetafi_tmp(1:iip1,l)= dtetafi(ijb:ijb+iim,l) 
     726          dqfi_tmp(1:iip1,l,:) = dqfi(ijb:ijb+iim,l,:) 
     727          ENDDO
     728c$OMP END DO NOWAIT
     729
     730c$OMP MASTER
    666731          dpfi_tmp(1:iip1)     = dpfi(ijb:ijb+iim) 
    667           dqfi_tmp(1:iip1,:,:) = dqfi(ijb:ijb+iim,:,:) 
    668         endif
    669        
     732c$OMP END MASTER
     733        endif
     734
     735c$OMP BARRIER
     736c$OMP MASTER
    670737        call SetDistrib(jj_nb_Physic_bis)
    671738
    … …  
    695762 
    696763        call SetDistrib(jj_nb_Physic)
    697        
     764c$OMP END MASTER
     765c$OMP BARRIER   
    698766                ijb=ij_begin
    699767        if (.not. pole_nord) then
    700           dufi(ijb:ijb+iim,:) = dufi(ijb:ijb+iim,:)+dufi_tmp(1:iip1,:)
    701           dvfi(ijb:ijb+iim,:) = dvfi(ijb:ijb+iim,:)+dvfi_tmp(1:iip1,:)
    702           dtetafi(ijb:ijb+iim,:) = dtetafi(ijb:ijb+iim,:)
    703      &                           +dtetafi_tmp(1:iip1,:)
     768       
     769c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     770          DO l=1,llm
     771            dufi(ijb:ijb+iim,l) = dufi(ijb:ijb+iim,l)+dufi_tmp(1:iip1,l)
     772            dvfi(ijb:ijb+iim,l) = dvfi(ijb:ijb+iim,l)+dvfi_tmp(1:iip1,l)
     773            dtetafi(ijb:ijb+iim,l) = dtetafi(ijb:ijb+iim,l)
     774     &                              +dtetafi_tmp(1:iip1,l)
     775            dqfi(ijb:ijb+iim,l,:) = dqfi(ijb:ijb+iim,l,:)
     776     &                              + dqfi_tmp(1:iip1,l,:)
     777          ENDDO
     778c$OMP END DO NOWAIT
     779
     780c$OMP MASTER
    704781          dpfi(ijb:ijb+iim)   = dpfi(ijb:ijb+iim)+ dpfi_tmp(1:iip1)
    705           dqfi(ijb:ijb+iim,:,:) = dqfi(ijb:ijb+iim,:,:)
    706      &                           + dqfi_tmp(1:iip1,:,:)
     782c$OMP END MASTER
     783         
    707784        endif
    708        
     785c$OMP BARRIER
     786cc$OMP MASTER   
    709787c      call WriteField_p('dufi',reshape(dufi,(/iip1,jmp1,llm/)))
    710788c      call WriteField_p('dvfi',reshape(dvfi,(/iip1,jjm,llm/)))
    711789c      call WriteField_p('dtetafi',reshape(dtetafi,(/iip1,jmp1,llm/)))
    712790c      call WriteField_p('dpfi',reshape(dpfi,(/iip1,jmp1/)))
     791cc$OMP END MASTER
    713792c     
    714793c      do j=1,nqmx
    … …  
    723802     $                 dufi, dvfi, dtetafi , dqfi ,dpfi  )
    724803
     804c$OMP BARRIER
     805c$OMP MASTER
    725806        call VTe(VTphysiq)
    726807
    … …  
    765846
    766847        call SetDistrib(jj_Nb_caldyn)
    767 c
    768 c  Diagnostique de conservation de l'énergie : difference
     848c$OMP END MASTER
     849c$OMP BARRIER
     850c
     851c  Diagnostique de conservation de l'energie : difference
    769852      IF (ip_ebil_dyn.ge.1 ) THEN
    770853          ztit='bil phys'
    … …  
    772855     e  , ucov    , vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2))
    773856      ENDIF
    774      
    775       if (debug) then
    776        call WriteField_p('ucovfi',reshape(ucov,(/iip1,jmp1,llm/)))
    777        call WriteField_p('vcovfi',reshape(vcov,(/iip1,jjm,llm/)))
    778        call WriteField_p('tetafi',reshape(teta,(/iip1,jmp1,llm/)))
    779       endif
     857
     858cc$OMP MASTER     
     859c      if (debug) then
     860c       call WriteField_p('ucovfi',reshape(ucov,(/iip1,jmp1,llm/)))
     861c       call WriteField_p('vcovfi',reshape(vcov,(/iip1,jjm,llm/)))
     862c       call WriteField_p('tetafi',reshape(teta,(/iip1,jmp1,llm/)))
     863c      endif
     864cc$OMP END MASTER
     865
    780866#else
    781867
    … …  
    799885
    800886c-jld
     887c$OMP MASTER
    801888         call resume_timer(timer_caldyn)
    802889         if (FirstPhysic) then
    … …  
    804891           FirstPhysic=.false.
    805892         endif
     893c$OMP END MASTER
     894c$OMP END PARALLEL
    806895       ENDIF
    807896
    … …  
    815904
    816905      IF(apdiss) THEN
     906c$OMP  PARALLEL DEFAULT(SHARED)
     907c$OMP+          PRIVATE(ijb,ije,tppn,tpn,tpps,tps)
     908c$OMP MASTER
    817909        call suspend_timer(timer_caldyn)
    818910       
    … …  
    822914
    823915        call VTb(VThallo)
    824 
     916c$OMP END MASTER
     917
     918c$OMP BARRIER
     919c$OMP MASTER
    825920        call Register_SwapFieldHallo(ucov,ucov,ip1jmp1,llm,
    826921     *                          jj_Nb_dissip,1,1,Request_dissip)
    … …  
    847942       
    848943        call start_timer(timer_dissip)
     944c$OMP END MASTER
     945c$OMP BARRIER
     946
    849947        call covcont_p(llm,ucov,vcov,ucont,vcont)
    850948        call enercin_p(vcov,ucov,vcont,ucont,ecin0)
    … …  
    853951
    854952        CALL dissip_p(vcov,ucov,teta,p,dvdis,dudis,dtetadis)
    855        
     953         
    856954        ijb=ij_begin
    857955        ije=ij_end
    858        
    859         ucov(ijb:ije,1:llm)=ucov(ijb:ije,1:llm)+dudis(ijb:ije,1:llm)
    860        
     956c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
     957        DO l=1,llm
     958          ucov(ijb:ije,l)=ucov(ijb:ije,l)+dudis(ijb:ije,l)
     959        ENDDO
     960c$OMP END DO NOWAIT     
    861961        if (pole_sud) ije=ije-iip1
    862         vcov(ijb:ije,1:llm)=vcov(ijb:ije,1:llm)+dvdis(ijb:ije,1:llm)
     962c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
     963        DO l=1,llm
     964          vcov(ijb:ije,l)=vcov(ijb:ije,l)+dvdis(ijb:ije,l)
     965        ENDDO
     966c$OMP END DO NOWAIT     
     967
    863968c       teta=teta+dtetadis
    864969
    … …  
    868973C       On rajoute la tendance due a la transform. Ec -> E therm. cree
    869974C       lors de la dissipation
     975c$OMP BARRIER
     976c$OMP MASTER
    870977            call suspend_timer(timer_dissip)
    871978            call VTb(VThallo)
    … …  
    877984            call VTe(VThallo)
    878985            call resume_timer(timer_dissip)
    879            
     986c$OMP END MASTER
     987c$OMP BARRIER       
    880988            call covcont_p(llm,ucov,vcov,ucont,vcont)
    881989            call enercin_p(vcov,ucov,vcont,ucont,ecin)
    … …  
    883991            ijb=ij_begin
    884992            ije=ij_end
    885            
     993c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)         
    886994            do l=1,llm
    887995              do ij=ijb,ije
    … …  
    890998              enddo
    891999            enddo
    892            
     1000c$OMP END DO NOWAIT         
    8931001       endif
    8941002
    8951003       ijb=ij_begin
    8961004       ije=ij_end
    897            
     1005c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)         
    8981006         do l=1,llm
    8991007           do ij=ijb,ije
    … …  
    9011009           enddo
    9021010         enddo
    903          
     1011c$OMP END DO NOWAIT     
    9041012c------------------------------------------------------------------------
    9051013
    … …  
    9131021         
    9141022        if (pole_nord) then
     1023c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    9151024          DO l  =  1, llm
    9161025            DO ij =  1,iim
    … …  
    9231032            ENDDO
    9241033          ENDDO
    925                
     1034c$OMP END DO NOWAIT
     1035
     1036c$OMP MASTER               
    9261037          DO ij =  1,iim
    9271038            tppn(ij)  = aire(  ij    ) * ps (  ij    )
    … …  
    9321043            ps(  ij    ) = tpn
    9331044          ENDDO
     1045c$OMP END MASTER
    9341046        endif
    9351047       
    9361048        if (pole_sud) then
     1049c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    9371050          DO l  =  1, llm
    9381051            DO ij =  1,iim
    … …  
    9451058            ENDDO
    9461059          ENDDO
    947                
     1060c$OMP END DO NOWAIT
     1061
     1062c$OMP MASTER               
    9481063          DO ij =  1,iim
    9491064            tpps(ij)  = aire(ij+ip1jm) * ps (ij+ip1jm)
    … …  
    9541069            ps(ij+ip1jm) = tps
    9551070          ENDDO
     1071c$OMP END MASTER
    9561072        endif
    9571073
     1074
     1075c$OMP BARRIER
     1076c$OMP MASTER
    9581077        call VTe(VTdissipation)
    9591078
    … …  
    9831102        call resume_timer(timer_caldyn)
    9841103        print *,'fin dissipation'
     1104c$OMP END MASTER
     1105c$OMP END PARALLEL
    9851106      END IF
    9861107
    … …  
    10661187
    10671188            IF( itau. EQ. itaufinp1 ) then 
    1068 c$$$       write(79,*) 'ucov',ucov
    1069 c$$$       write(80,*) 'vcov',vcov
    1070 c$$$       write(81,*) 'teta',teta
    1071 c$$$       write(82,*) 'ps',ps
    1072 c$$$       write(83,*) 'q',q
    1073 c$$$       WRITE(85,*) 'q1 = ',q(:,:,1)
    1074 c$$$       WRITE(86,*) 'q3 = ',q(:,:,3)
    1075 
     1189
     1190              call finalize_parallel
    10761191              abort_message = 'Simulation finished'
    1077 
    10781192              call abort_gcm(modname,abort_message,0)
    10791193            ENDIF
    … …  
    11611275
    11621276
    1163 #ifdef CPP_IOIPSL
     1277c#ifdef CPP_IOIPSL
    11641278       CALL dynredem1_p("restart.nc",0.0,
    11651279     ,                     vcov,ucov,teta,q,nqmx,masse,ps)
    1166 #endif
     1280c#endif
    11671281
    11681282              CLOSE(99)
    … …  
    12181332               forward =  .FALSE.
    12191333               IF( itau. EQ. itaufinp1 ) then 
     1334                 call finalize_parallel
    12201335                 abort_message = 'Simulation finished'
    12211336                 call abort_gcm(modname,abort_message,0)
    … …  
    12961411               ENDIF
    12971412
    1298 #ifdef CPP_IOIPSL
     1413c#ifdef CPP_IOIPSL
    12991414                 IF(itau.EQ.itaufin)
    13001415     . CALL dynredem1_p("restart.nc",0.0,
    13011416     .                     vcov,ucov,teta,q,nqmx,masse,ps)
    1302 #endif
     1417c#endif
    13031418
    13041419                 forward = .TRUE.
    … …  
    13091424      END IF
    13101425
    1311       STOP
     1426        call finalize_parallel
     1427        STOP
    13121428      END

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

    r630 r764  
    4848      REAL      SSUM,CVMGP,CVMGT
    4949      integer ismax,ismin
    50       EXTERNAL  SSUM, convflu,ismin,ismax
    51       EXTERNAL filtreg
     50      EXTERNAL  SSUM, ismin,ismax
    5251
    5352      data first/.true./

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

    r630 r764  
    5252      REAL      SSUM
    5353      integer ismax,ismin
    54       EXTERNAL  SSUM, convflu,ismin,ismax
    55       EXTERNAL filtreg
     54      EXTERNAL  SSUM, ismin,ismax
    5655
    5756      data first/.true./

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

    r630 r764  
    4848      REAL      SSUM,CVMGP,CVMGT
    4949      integer ismax,ismin
    50       EXTERNAL  SSUM, convflu,ismin,ismax
    51       EXTERNAL filtreg
     50      EXTERNAL  SSUM, ismin,ismax
    5251
    5352      data first/.true./

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

    r630 r764  
    7676     
    7777     
    78      
     78c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 
    7979      DO   100    l = 1 , llm
    8080c
    … …  
    112112
    113113100   CONTINUE
     114c$OMP END DO NOWAIT
    114115c
    115116      RETURN

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

    r630 r764  
    3131      if (pole_sud)  ije=ije-iip1
    3232
     33c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
    3334      DO   100    l = 1 , llm
    3435c
    … …  
    4950
    5051100   CONTINUE
     52c$OMP END DO NOWAIT
    5153c
    5254      RETURN

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

    r630 r764  
    9292      if (pole_sud)  ije=ij_end
    9393
     94c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
    9495      DO   100    l = 1 , llm
    9596c
    … …  
    114115       
    115116100   CONTINUE
     117c$OMP END DO NOWAIT
    116118c
    117119      RETURN

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

    r630 r764  
    33implicit none
    44!  include 'mpif.h'
    5   integer, parameter :: MaxRequest=80
     5  integer, parameter :: MaxRequest=200
    66  integer, parameter :: MaxProc=80
    77  integer, parameter :: MaxBufferSize=1024*1024*16
    … …  
    385385!         print *, 'process',MPI_RANK,'ISSEND: requette ',a_request%tag,'au process',rank,'de taille',SizeBuffer
    386386!         call MPI_ISSEND(Req%Buffer,SizeBuffer,MPI_REAL8,rank,a_request%tag,     &
    387 !                         MPI_COMM_WORLD,Req%MSG_Request,ierr)
     387!                         COMM_LMDZ,Req%MSG_Request,ierr)
    388388         call MPI_ISSEND(Buffer(req%Pos),SizeBuffer,MPI_REAL8,rank,a_request%tag,     &
    389                          MPI_COMM_WORLD,Req%MSG_Request,ierr)
     389                         COMM_LMDZ,Req%MSG_Request,ierr)
    390390
    391391        endif
    … …  
    410410           
    411411!           call MPI_IRECV(Req%Buffer,SizeBuffer,MPI_REAL8,rank,a_request%tag,     &
    412 !                           MPI_COMM_WORLD,Req%MSG_Request,ierr)
     412!                           COMM_LMDZ,Req%MSG_Request,ierr)
    413413            call MPI_IRECV(Buffer(Req%Pos),SizeBuffer,MPI_REAL8,rank,a_request%tag,     &
    414                            MPI_COMM_WORLD,Req%MSG_Request,ierr)
     414                           COMM_LMDZ,Req%MSG_Request,ierr)
    415415
    416416          endif
    … …  
    430430      type(request_SR),pointer :: Req
    431431      type(Hallo),pointer :: PtrHallo
    432       integer, dimension(4) :: TabRequest
    433       integer, dimension(MPI_STATUS_SIZE,4) :: TabStatus
     432      integer, dimension(2*mpi_size) :: TabRequest
     433      integer, dimension(MPI_STATUS_SIZE,2*mpi_size) :: TabStatus
    434434      integer :: NbRequest
    435435      integer :: i,rank,pos,ij,l,ierr
    … …  
    512512      type(request_SR),pointer :: Req
    513513      type(Hallo),pointer :: PtrHallo
    514       integer, dimension(4) :: TabRequest
    515       integer, dimension(MPI_STATUS_SIZE,4) :: TabStatus
     514      integer, dimension(mpi_size) :: TabRequest
     515      integer, dimension(MPI_STATUS_SIZE,mpi_size) :: TabStatus
    516516      integer :: NbRequest
    517517      integer :: i,rank,pos,ij,l,ierr
    … …  
    553553      type(request_SR),pointer :: Req
    554554      type(Hallo),pointer :: PtrHallo
    555       integer, dimension(4) :: TabRequest
    556       integer, dimension(MPI_STATUS_SIZE,4) :: TabStatus
     555      integer, dimension(mpi_size) :: TabRequest
     556      integer, dimension(MPI_STATUS_SIZE,mpi_size) :: TabStatus
    557557      integer :: NbRequest
    558558      integer :: i,rank,pos,ij,l,ierr

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

    r630 r764  
    2222      INTEGER :: ijb,ije
    2323c
     24c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    2425      DO 10 l = 1,klevel
    2526c
    … …  
    6263c
    6364  10  CONTINUE
     65c$OMP END DO NOWAIT
    6466      RETURN
    6567      END

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

    r630 r764  
    2121c
    2222c
    23      
     23c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    2424      DO 10 l = 1,klevel
    2525c
    … …  
    6363c
    6464  10  CONTINUE
     65c$OMP END DO NOWAIT
    6566      RETURN
    6667      END

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

    r630 r764  
    1        SUBROUTINE nxgraro2_p (klevel,xcov, ycov, lr, grx, gry )
     1       SUBROUTINE nxgraro2_p (klevel,xcov, ycov, lr, grx_out, gry_out )
    22c
    33c      P.Le Van .
    … …  
    2525      INTEGER klevel
    2626      REAL xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel )
    27       REAL  grx( ip1jmp1,klevel ),  gry( ip1jm,klevel )
     27      REAL,SAVE ::  grx( ip1jmp1,llm ),  gry( ip1jm,llm )
     28      REAL  grx_out( ip1jmp1,klevel ),  gry_out( ip1jm,klevel )
    2829c
    2930c    ......   variables locales     ........
    3031c
    31       REAL rot(ip1jm,llm) , signe, nugradrs
     32      REAL,SAVE :: rot(ip1jm,llm)
     33      REAL  signe, nugradrs
    3234      INTEGER l,ij,iter,lr
    3335c    ........................................................
    3436c
    35       EXTERNAL    filtreg
    36       EXTERNAL  SCOPY, rotatf, nxgrad, laplacien_rotgam
    3737      INTEGER :: ijb,ije,jjb,jje
    3838     
    … …  
    4747      ijb=ij_begin
    4848      ije=ij_end
    49       grx(ijb:ije,1:klevel)=xcov(ijb:ije,1:klevel)
    50      
     49
     50c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     51      DO    l = 1, klevel
     52        grx(ijb:ije,l)=xcov(ijb:ije,l)
     53      ENDDO
     54c$OMP END DO NOWAIT
     55
     56c$OMP BARRIER
     57c$OMP MASTER         
    5158      call suspend_timer(timer_dissip)
    5259      call exchange_Hallo(grx,ip1jmp1,llm,0,1)
    5360      call resume_timer(timer_dissip)
     61c$OMP END MASTER
     62c$OMP BARRIER
    5463
    5564      ijb=ij_begin
    5665      ije=ij_end
    5766      if(pole_sud) ije=ij_end-iip1
    58       gry(ijb:ije,1:klevel)=ycov(ijb:ije,1:klevel)
     67
     68c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     69      DO    l = 1, klevel
     70        gry(ijb:ije,l)=ycov(ijb:ije,l)
     71      ENDDO
     72c$OMP END DO NOWAIT
     73 
    5974c
    6075      CALL     rotatf_p     ( klevel, grx, gry, rot )
    6176c      call write_field3d_p('rot1',reshape(rot,(/iip1,jjm,llm/)))
    62      
     77
     78c$OMP BARRIER
     79c$OMP MASTER     
    6380      call suspend_timer(timer_dissip)
    6481      call exchange_Hallo(rot,ip1jm,llm,1,1)
    6582      call resume_timer(timer_dissip)
     83c$OMP END MASTER
     84c$OMP BARRIER
    6685     
    6786      CALL laplacien_rot_p ( klevel, rot, rot,grx,gry      )
    … …  
    7190c
    7291      DO  iter = 1, lr -2
     92c$OMP BARRIER
     93c$OMP MASTER
    7394        call suspend_timer(timer_dissip)
    7495        call exchange_Hallo(rot,ip1jm,llm,1,1)
    7596        call resume_timer(timer_dissip)
     97c$OMP END MASTER
     98c$OMP BARRIER
    7699        CALL laplacien_rotgam_p ( klevel, rot, rot )
    77100      ENDDO
    … …  
    86109       
    87110      CALL filtreg_p( rot, jjb,jje,jjm, klevel, 2,1, .FALSE.,1)
     111c$OMP BARRIER
     112c$OMP MASTER
    88113      call suspend_timer(timer_dissip)
    89114      call exchange_Hallo(rot,ip1jm,llm,1,0)
    90115      call resume_timer(timer_dissip)
     116c$OMP END MASTER
     117c$OMP BARRIER
    91118      CALL nxgrad_p ( klevel, rot, grx, gry )
    92119
    … …  
    94121      ijb=ij_begin
    95122      ije=ij_end
    96    
     123     
     124c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
    97125      DO    l = 1, klevel
    98126       
    99127         if(pole_sud) ije=ij_end-iip1
    100128         DO  ij = ijb, ije
    101           gry( ij,l ) = gry( ij,l ) * nugradrs
     129          gry_out( ij,l ) = gry( ij,l ) * nugradrs
    102130         ENDDO
    103131       
    104132         if(pole_sud) ije=ij_end
    105133         DO  ij = ijb, ije
    106           grx( ij,l ) = grx( ij,l ) * nugradrs
     134          grx_out( ij,l ) = grx( ij,l ) * nugradrs
    107135         ENDDO
    108136     
    109137      ENDDO
     138c$OMP END DO NOWAIT
    110139c
    111140      RETURN

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

    r630 r764  
    1       SUBROUTINE nxgrarot_p (klevel,xcov, ycov, lr, grx, gry )
     1      SUBROUTINE nxgrarot_p (klevel,xcov, ycov, lr, grx_out, gry_out )
    22c   ***********************************************************
    33c
    … …  
    2626      INTEGER klevel
    2727      REAL xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel )
    28       REAL  grx( ip1jmp1,klevel ),  gry( ip1jm,klevel )
     28      REAL  grx_out( ip1jmp1,klevel ),  gry_out( ip1jm,klevel )
     29      REAL,SAVE ::  grx( ip1jmp1,llm ),  gry( ip1jm,llm )
     30
    2931c
    30       REAL rot(ip1jm,llm)
     32      REAL,SAVE :: rot(ip1jm,llm)
    3133
    3234      INTEGER l,ij,iter,lr
    3335c
    34       EXTERNAL    filtreg
    35       EXTERNAL       SCOPY, rotat, nXgrad
    3636      INTEGER ijb,ije,jjb,jje
    3737c
    … …  
    4242      ijb=ij_begin
    4343      ije=ij_end
    44       grx(ijb:ije,1:klevel)=xcov(ijb:ije,1:klevel)
    45      
     44c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 
     45      DO l = 1, klevel
     46        grx(ijb:ije,l)=xcov(ijb:ije,l)
     47      ENDDO
     48c$OMP END DO NOWAIT     
     49
    4650      if(pole_sud) ije=ij_end-iip1
    47       gry(ijb:ije,1:klevel)=ycov(ijb:ije,1:klevel)
     51c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
     52      DO l = 1, klevel
     53        gry(ijb:ije,l)=ycov(ijb:ije,l)
     54      ENDDO
     55c$OMP END DO NOWAIT
    4856     
    4957      DO 10 iter = 1,lr
     58c$OMP BARRIER
     59c$OMP MASTER
    5060      call suspend_timer(timer_dissip)
    5161      call exchange_Hallo(grx,ip1jmp1,llm,0,1)
    5262      call resume_timer(timer_dissip)
     63c$OMP END MASTER
     64c$OMP BARRIER
     65
    5366      CALL  rotat_p (klevel,grx, gry, rot )
    5467c      call write_field3d_p('rot',reshape(rot,(/iip1,jjm,llm/)))
    … …  
    5871      if (pole_sud) jje=jj_end-1
    5972      CALL filtreg_p( rot,jjb,jje, jjm, klevel, 2,1, .false.,2)
    60      
     73
     74c$OMP BARRIER
     75c$OMP MASTER
    6176      call suspend_timer(timer_dissip)
    6277      call exchange_Hallo(rot,ip1jm,llm,1,0)
    6378      call resume_timer(timer_dissip)
     79c$OMP END MASTER
     80c$OMP BARRIER
    6481     
    6582      CALL nxgrad_p (klevel,rot, grx, gry )
    6683c
     84c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    6785      DO 5  l = 1, klevel
    6886      if(pole_sud) ije=ij_end-iip1
    6987      DO 2 ij = ijb, ije
    70       gry( ij,l ) = - gry( ij,l ) * crot
     88      gry_out( ij,l ) = - gry( ij,l ) * crot
    7189   2  CONTINUE
    7290      if(pole_sud) ije=ij_end
    7391      DO 3 ij = ijb, ije
    74       grx( ij,l ) = - grx( ij,l ) * crot
     92      grx_out( ij,l ) = - grx( ij,l ) * crot
    7593   3  CONTINUE
    7694   5  CONTINUE
    77 
     95c$OMP END DO NOWAIT
    7896c      call write_field3d_p('grx',reshape(grx,(/iip1,jjp1,llm/)))
    7997c      call write_field3d_p('gry',reshape(gry,(/iip1,jjm,llm/)))

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

    r630 r764  
    33    integer, save :: mpi_size
    44    integer, save :: mpi_rank
     5    integer, save :: COMM_LMDZ
    56    integer, save :: jj_begin
    67    integer, save :: jj_end
    … …  
    1415    integer, allocatable, save, dimension(:) :: jj_end_para
    1516    integer, allocatable, save, dimension(:) :: jj_nb_para
     17    integer, save :: OMP_CHUNK
    1618   
    1719 contains
    … …  
    1921    subroutine init_parallel
    2022    USE vampir
     23#ifdef CPP_COUPLE
     24#ifdef CPP_PSMILE
     25    USE mod_prism_proto
     26#endif
     27#endif
    2128    implicit none
    2229   
    … …  
    2532      integer :: type_size
    2633      integer, dimension(3) :: blocklen,type
     34      integer :: comp_id
    2735     
    2836     
    … …  
    3038#include "dimensions90.h"
    3139#include "paramet90.h"
    32      
     40
     41#ifdef CPP_COUPLE
     42#ifdef CPP_PSMILE
     43       call prism_init_comp_proto (comp_id, 'lmdz.x', ierr)
     44       call prism_get_localcomm_proto(COMM_LMDZ,ierr)
     45#endif
     46#else     
    3347      call MPI_INIT(ierr)
     48      COMM_LMDZ=MPI_COMM_WORLD
     49#endif
    3450      call InitVampir
    35       call MPI_COMM_SIZE(MPI_COMM_WORLD,mpi_size,ierr)
    36       call MPI_COMM_RANK(MPI_COMM_WORLD,mpi_rank,ierr)
     51      call MPI_COMM_SIZE(COMM_LMDZ,mpi_size,ierr)
     52      call MPI_COMM_RANK(COMM_LMDZ,mpi_rank,ierr)
    3753 
    3854     
    … …  
    5066          print *," ---> diminuez le nombre de CPU ou augmentez la taille en lattitude"
    5167         
    52           call MPI_ABORT(MPI_COMM_WORLD,-1, ierr)
     68          call MPI_ABORT(COMM_LMDZ,-1, ierr)
    5369         
    5470        endif
    … …  
    133149   
    134150    subroutine Finalize_parallel
     151#ifdef CPP_COUPLE
     152#ifdef CPP_PSMILE
     153    use mod_prism_proto
     154#endif
     155#endif
    135156    implicit none
    136157
    … …  
    144165      deallocate(jj_end_para)
    145166      deallocate(jj_nb_para)
    146      
     167
     168#ifdef CPP_COUPLE
     169#ifdef CPP_PSMILE
     170     call prism_terminate_proto(ierr)
     171     IF (ierr .ne. PRISM_Ok) THEN
     172       call abort_gcm('Finalize_parallel',' Probleme dans prism_terminate_proto ',1)
     173     endif
     174#endif
     175#else         
    147176      call MPI_FINALIZE(ierr)
     177#endif
    148178     
    149179    end subroutine Finalize_parallel
    150    
     180       
    151181    subroutine Pack_Data(Field,ij,ll,row,Buffer)
    152182    implicit none
    … …  
    217247      INTEGER :: Buffer_size     
    218248     
    219       call MPI_Barrier(MPI_COMM_WORLD,ierr)
     249      call MPI_Barrier(COMM_LMDZ,ierr)
    220250      call VTb(VThallo)
    221251     
    … …  
    253283        call PACK_Data(Field(ij_begin,1),ij,ll,down,Buffer_Send_up)
    254284        call MPI_ISSEND(Buffer_send_up,Buffer_Size,MPI_REAL8,MPI_Rank-1,1,     &
    255                         MPI_COMM_WORLD,Request(NbRequest),ierr)
     285                        COMM_LMDZ,Request(NbRequest),ierr)
    256286      ENDIF
    257287 
    … …  
    264294       
    265295        call MPI_ISSEND(Buffer_send_down,Buffer_Size,MPI_REAL8,MPI_Rank+1,1,     &
    266                         MPI_COMM_WORLD,Request(NbRequest),ierr)
     296                        COMM_LMDZ,Request(NbRequest),ierr)
    267297      ENDIF
    268298   
    … …  
    274304             
    275305        call MPI_IRECV(Buffer_recv_up,Buffer_size,MPI_REAL8,MPI_Rank-1,1,  &
    276                         MPI_COMM_WORLD,Request(NbRequest),ierr)
     306                        COMM_LMDZ,Request(NbRequest),ierr)
    277307     
    278308       
    … …  
    285315       
    286316        call MPI_IRECV(Buffer_recv_down,Buffer_size,MPI_REAL8,MPI_Rank+1,1,     &
    287                         MPI_COMM_WORLD,Request(NbRequest),ierr)
     317                        COMM_LMDZ,Request(NbRequest),ierr)
    288318     
    289319       
    … …  
    295325
    296326      call VTe(VThallo)
    297       call MPI_Barrier(MPI_COMM_WORLD,ierr)
     327      call MPI_Barrier(COMM_LMDZ,ierr)
    298328      RETURN
    299329     
    … …  
    349379     
    350380      call MPI_GATHERV(Buffer_send,(min(ij_end,ij)-ij_begin+1)*ll,MPI_REAL8,   &
    351                         Buffer_Recv,Recv_count,displ,MPI_REAL8,rank,MPI_COMM_WORLD,ierr)
     381                        Buffer_Recv,Recv_count,displ,MPI_REAL8,rank,COMM_LMDZ,ierr)
    352382     
    353383      if (MPI_Rank==rank) then                 
    … …  
    380410     
    381411      call Gather_Field(Field,ij,ll,0)
    382       call MPI_BCAST(Field,ij*ll,MPI_REAL8,0,MPI_COMM_WORLD)
     412      call MPI_BCAST(Field,ij*ll,MPI_REAL8,0,COMM_LMDZ,ierr)
    383413     
    384414    end subroutine AllGather_Field
    … …  
    395425      INTEGER :: ierr
    396426     
    397       call MPI_BCAST(Field,ij*ll,MPI_REAL8,rank,MPI_COMM_WORLD)
     427      call MPI_BCAST(Field,ij*ll,MPI_REAL8,rank,COMM_LMDZ,ierr)
    398428     
    399429    end subroutine Broadcast_Field

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

    r630 r764  
    5656      REAL      SSUM
    5757      integer ismax,ismin,lati,latf
    58       EXTERNAL  SSUM, convflu,ismin,ismax
     58      EXTERNAL  SSUM, ismin,ismax
    5959      logical first
    6060      save first
    6161c   fin modif
    6262
    63 c      EXTERNAL masskg
    64       EXTERNAL advx
    65       EXTERNAL advy
    66       EXTERNAL advz
    6763
    6864c  modif Fred 24 03 96

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

    r630 r764  
    737737c     j=1 c'est le pôle Sud, j=JNP c'est le pôle Nord
    738738      Q(I,  2,k,IC) = Q(I,  1,k,IC)
    739       Q(I,JMR,k,IC) = Q(I,JMP,k,IC)
     739      Q(I,JMR,k,IC) = Q(I,JNP,k,IC)
    740740400   CONTINUE
    741741      endif

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

    r630 r764  
    6060      REAL      SSUM
    6161      integer ismax,ismin
    62       EXTERNAL  SSUM, convflu,ismin,ismax
     62      EXTERNAL  SSUM, ismin,ismax
    6363      logical first
    6464      save first
    65       EXTERNAL advxp,advyp,advzp
    66 
    6765
    6866      data first/.true./

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

    r630 r764  
    2929      if (pole_nord) ijb=ij_begin
    3030      if (pole_sud)  ije=ij_end
    31      
     31
     32c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    3233      DO    l    = 1, llmp1
    3334        DO  ij   = ijb, ije
    … …  
    3536        ENDDO
    3637      ENDDO
    37    
     38c$OMP END DO NOWAIT   
    3839      RETURN
    3940      END

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

    r630 r764  
    1010c   mode=1 variabels GCM
    1111
     12       USE parallel
    1213c -----------------------------------------------------------------
    1314c   Declarations
    … …  
    4243      integer ncidpl
    4344      integer varidpl,ncidQ,varidQ
    44       save ncidu,varidu,ncidv,varidv,ncidt,varidt,ncidps,varidps
     45      save ncidpl,ncidu,varidu,ncidv,varidv,ncidt,varidt,ncidps,varidps
    4546      save varidpl,ncidQ,varidQ
    4647
    … …  
    5556      logical first
    5657      save first
     58      INTEGER ierr
    5759
    5860      data first/.true./
    … …  
    6971c Vent zonal
    7072            if (guide_u) then
    71             ncidu=NCOPN('u.nc',NCNOWRIT,rcode)
    72             varidu=NCVID(ncidu,'UWND',rcode)
    73             print*,'ncidu,varidu',ncidu,varidu
    74             if (ncidpl.eq.-99) ncidpl=ncidu
     73               ncidu=NCOPN('u.nc',NCNOWRIT,rcode)
     74               varidu=NCVID(ncidu,'UWND',rcode)
     75               print*,'ncidu,varidu',ncidu,varidu
     76               if (ncidpl.eq.-99) ncidpl=ncidu
    7577            endif
    7678
    7779c Vent meridien
    7880            if (guide_v) then
    79             ncidv=NCOPN('v.nc',NCNOWRIT,rcode)
    80             varidv=NCVID(ncidv,'VWND',rcode)
    81             print*,'ncidv,varidv',ncidv,varidv
    82             if (ncidpl.eq.-99) ncidpl=ncidu
    83             endif
     81               ncidv=NCOPN('v.nc',NCNOWRIT,rcode)
     82               varidv=NCVID(ncidv,'VWND',rcode)
     83               print*,'ncidv,varidv',ncidv,varidv
     84               if (ncidpl.eq.-99) ncidpl=ncidu
     85            endif
     86           
    8487
    8588c Temperature
    8689            if (guide_T) then
    87             ncidt=NCOPN('T.nc',NCNOWRIT,rcode)
    88             varidt=NCVID(ncidt,'AIR',rcode)
    89             print*,'ncidt,varidt',ncidt,varidt
    90             if (ncidpl.eq.-99) ncidpl=ncidu
    91             endif
    92 
     90               ncidt=NCOPN('T.nc',NCNOWRIT,rcode)
     91               varidt=NCVID(ncidt,'AIR',rcode)
     92               print*,'ncidt,varidt',ncidt,varidt
     93               if (ncidpl.eq.-99) ncidpl=ncidu
     94            endif
     95           
    9396c Humidite
    9497            if (guide_Q) then
    95             ncidQ=NCOPN('hur.nc',NCNOWRIT,rcode)
    96             varidQ=NCVID(ncidQ,'RH',rcode)
    97             print*,'ncidQ,varidQ',ncidQ,varidQ
    98             if (ncidpl.eq.-99) ncidpl=ncidu
    99             endif
    100 
     98               ncidQ=NCOPN('hur.nc',NCNOWRIT,rcode)
     99               varidQ=NCVID(ncidQ,'RH',rcode)
     100               print*,'ncidQ,varidQ',ncidQ,varidQ
     101               if (ncidpl.eq.-99) ncidpl=ncidu
     102            endif
     103           
    101104c Pression de surface
    102105            if (guide_P) then
    103             ncidps=NCOPN('ps.nc',NCNOWRIT,rcode)
    104             varidps=NCVID(ncidps,'SP',rcode)
    105             print*,'ncidps,varidps',ncidps,varidps
    106             endif
    107 
     106               ncidps=NCOPN('ps.nc',NCNOWRIT,rcode)
     107               varidps=NCVID(ncidps,'SP',rcode)
     108               print*,'ncidps,varidps',ncidps,varidps
     109            endif
     110           
    108111c Coordonnee vertcale
    109112            if (ncep) then
    … …  
    134137      status=NF_GET_VARA_REAL(ncidpl,varidpl,1,nlevnc,pl)
    135138#endif
     139     
    136140c  passage en pascal
    137141      pl(:)=100.*pl(:)
    … …  
    160164      count(4)=1
    161165
     166
     167c mise a zero des tableaux
     168c ------------------------
     169       unc(:,:,:)=0.
     170       vnc(:,:,:)=0.
     171       tnc(:,:,:)=0.
     172       Qnc(:,:,:)=0.
     173
    162174c  Vent zonal
    163175c  ----------
    164176
    165177      if (guide_u) then
    166       print*,'avant la lecture de UNCEP nd de niv:',nlevnc
     178         print*,'avant la lecture de UNCEP nd de niv:',nlevnc
     179
    167180#ifdef NC_DOUBLE
    168       status=NF_GET_VARA_DOUBLE(ncidu,varidu,start,count,unc)
     181         status=NF_GET_VARA_DOUBLE(ncidu,varidu,start,count,unc)
    169182#else
    170       status=NF_GET_VARA_REAL(ncidu,varidu,start,count,unc)
     183         status=NF_GET_VARA_REAL(ncidu,varidu,start,count,unc)
    171184#endif
    172185c     call dump2d(iip1,jjp1,unc,'VENT NCEP   ')
    173186c     call dump2d(iip1,40,unc(1,1,nlevnc),'VENT NCEP   ')
    174       print*,'WARNING!!! Correction bidon pour palier a un '
    175       print*,'probleme dans la creation des fichiers nc'
    176       call correctbid(iim,jjp1*nlevnc,unc)
    177       call dump2d(iip1,jjp1,unc,'UNC COUCHE 1 ')
     187         print*,'WARNING!!! Correction bidon pour palier a un '
     188         print*,'probleme dans la creation des fichiers nc'
     189         call correctbid(iim,jjp1*nlevnc,unc)
     190         call dump2d(iip1,jjp1,unc,'UNC COUCHE 1 ')
    178191      endif
    179192
    … …  
    185198      if (guide_T) then
    186199#ifdef NC_DOUBLE
    187       status=NF_GET_VARA_DOUBLE(ncidt,varidt,start,count,tnc)
     200         status=NF_GET_VARA_DOUBLE(ncidt,varidt,start,count,tnc)
    188201#else
    189       status=NF_GET_VARA_REAL(ncidt,varidt,start,count,tnc)
     202         status=NF_GET_VARA_REAL(ncidt,varidt,start,count,tnc)
    190203#endif
    191       call dump2d(iip1,jjp1,tnc,'TNC COUCHE 1 AAA ')
    192       call correctbid(iim,jjp1*nlevnc,tnc)
    193       call dump2d(iip1,jjp1,tnc,'TNC COUCHE 1 BBB ')
     204         call dump2d(iip1,jjp1,tnc,'TNC COUCHE 1 AAA ')
     205         call correctbid(iim,jjp1*nlevnc,tnc)
     206         call dump2d(iip1,jjp1,tnc,'TNC COUCHE 1 BBB ')
    194207      endif
    195208
    … …  
    199212      if (guide_Q) then
    200213#ifdef NC_DOUBLE
    201       status=NF_GET_VARA_DOUBLE(ncidQ,varidQ,start,count,Qnc)
     214         status=NF_GET_VARA_DOUBLE(ncidQ,varidQ,start,count,Qnc)
    202215#else
    203       status=NF_GET_VARA_REAL(ncidQ,varidQ,start,count,Qnc)
     216         status=NF_GET_VARA_REAL(ncidQ,varidQ,start,count,Qnc)
    204217#endif
    205       call correctbid(iim,jjp1*nlevnc,Qnc)
    206       call dump2d(iip1,jjp1,Qnc,'QNC COUCHE 1 ')
     218         call correctbid(iim,jjp1*nlevnc,Qnc)
     219         call dump2d(iip1,jjp1,Qnc,'QNC COUCHE 1 ')
    207220      endif
    208221
    … …  
    213226      if (guide_v) then
    214227#ifdef NC_DOUBLE
    215       status=NF_GET_VARA_DOUBLE(ncidv,varidv,start,count,vnc)
     228         status=NF_GET_VARA_DOUBLE(ncidv,varidv,start,count,vnc)
    216229#else
    217       status=NF_GET_VARA_REAL(ncidv,varidv,start,count,vnc)
     230         status=NF_GET_VARA_REAL(ncidv,varidv,start,count,vnc)
    218231#endif
    219       call correctbid(iim,jjm*nlevnc,vnc)
    220       call dump2d(iip1,jjm,vnc,'VNC COUCHE 1 ')
     232         call correctbid(iim,jjm*nlevnc,vnc)
     233         call dump2d(iip1,jjm,vnc,'VNC COUCHE 1 ')
    221234      endif
    222235
    … …  
    232245      if (guide_P) then
    233246#ifdef NC_DOUBLE
    234       status=NF_GET_VARA_DOUBLE(ncidps,varidps,start,count,psnc)
     247         status=NF_GET_VARA_DOUBLE(ncidps,varidps,start,count,psnc)
    235248#else
    236       status=NF_GET_VARA_REAL(ncidps,varidps,start,count,psnc)
     249         status=NF_GET_VARA_REAL(ncidps,varidps,start,count,psnc)
    237250#endif
    238       call dump2d(iip1,jjp1,psnc,'PSNC COUCHE 1 ')
    239       call correctbid(iim,jjp1,psnc)
     251         call dump2d(iip1,jjp1,psnc,'PSNC COUCHE 1 ')
     252         call correctbid(iim,jjp1,psnc)
    240253      endif
    241254

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

    r630 r764  
    3232      ije=ij_end
    3333      if(pole_sud) ije=ij_end-iip1
    34      
     34c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)      
    3535      DO  10 l = 1,klevel
    3636c
    … …  
    4848c
    4949  10  CONTINUE
    50 
     50c$OMP END DO NOWAIT
    5151      RETURN
    5252      END

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

    r630 r764  
    3333      if(pole_sud) ije=ij_end-iip1
    3434     
     35c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    3536      DO  10 l = 1,klevel
    3637c
    … …  
    4849c
    4950  10  CONTINUE
    50 
     51c$OMP END DO NOWAIT
    5152ccc        CALL filtreg( rot, jjm, klevel, 2, 2, .FALSE., 1 )
    52      
     53c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    5354        DO l = 1, klevel
    5455          DO ij = ijb, ije
    … …  
    5657          ENDDO
    5758        ENDDO
     59c$OMP END DO NOWAIT
    5860c
    5961c

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

    r630 r764  
    3232      ije=ij_end
    3333      if(pole_sud) ije=ij_end-iip1
    34      
     34
     35c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    3536      DO  10 l = 1,klevel
    3637c
    … …  
    4849c
    4950  10  CONTINUE
    50 
     51c$OMP END DO NOWAIT
    5152        jjb=jj_begin
    5253        jje=jj_end
    5354        if (pole_sud) jje=jj_end-1
    5455        CALL filtreg_p( rot, jjb,jje,jjm, klevel, 2, 2, .FALSE., 1 )
    55      
     56
     57c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
    5658        DO l = 1, klevel
    5759          DO ij = ijb, ije
    … …  
    5961          ENDDO
    6062        ENDDO
     63c$OMP END DO NOWAIT
    6164c
    6265c

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

    r630 r764  
    126126        V2=timer_table_sqr(jj_nb,no_timer,mpi_rank)
    127127        V=timer_table(jj_nb,no_timer,mpi_rank)
    128         timer_delta(jj_nb,no_timer,mpi_rank)=sqrt((V2-V*V/N)/(N-1))
     128        timer_delta(jj_nb,no_timer,mpi_rank)=sqrt(abs(V2-V*V/N)/(N-1))
    129129      else
    130130        timer_delta(jj_nb,no_timer,mpi_rank)=0
    … …  
    148148   
    149149    tmp_table(:,:)=timer_table(:,:,mpi_rank)
    150     call mpi_allgather(tmp_table(1,1),data_size,MPI_REAL8,timer_table(1,1,mpi_rank),data_size,MPI_REAL8,MPI_COMM_WORLD,ierr)
     150    call mpi_allgather(tmp_table(1,1),data_size,MPI_REAL8,timer_table(1,1,mpi_rank),data_size,MPI_REAL8,COMM_LMDZ,ierr)
    151151
    152152    tmp_table(:,:)=timer_table_sqr(:,:,mpi_rank)
    153     call mpi_allgather(tmp_table(1,1),data_size,MPI_REAL8,timer_table_sqr(1,1,mpi_rank),data_size,MPI_REAL8,MPI_COMM_WORLD,ierr)
     153    call mpi_allgather(tmp_table(1,1),data_size,MPI_REAL8,timer_table_sqr(1,1,mpi_rank),data_size,MPI_REAL8,COMM_LMDZ,ierr)
    154154   
    155155    deallocate(tmp_table)
    … …  
    176176
    177177    tmp_table(:,:)=timer_average(:,:,mpi_rank)
    178     call mpi_allgather(tmp_table(1,1),data_size,MPI_REAL8,timer_average(1,1,0),data_size,MPI_REAL8,MPI_COMM_WORLD,ierr)
     178    call mpi_allgather(tmp_table(1,1),data_size,MPI_REAL8,timer_average(1,1,0),data_size,MPI_REAL8,COMM_LMDZ,ierr)
    179179
    180180    tmp_table(:,:)=timer_delta(:,:,mpi_rank)
    181     call mpi_allgather(tmp_table(1,1),data_size,MPI_REAL8,timer_delta(1,1,0),data_size,MPI_REAL8,MPI_COMM_WORLD,ierr)
     181    call mpi_allgather(tmp_table(1,1),data_size,MPI_REAL8,timer_delta(1,1,0),data_size,MPI_REAL8,COMM_LMDZ,ierr)
    182182
    183183    tmp_iter(:,:)=timer_iteration(:,:,mpi_rank)
    184     call mpi_allgather(tmp_iter(1,1),data_size,MPI_INTEGER,timer_iteration(1,1,0),data_size,MPI_INTEGER,MPI_COMM_WORLD,ierr)
     184    call mpi_allgather(tmp_iter(1,1),data_size,MPI_INTEGER,timer_iteration(1,1,0),data_size,MPI_INTEGER,COMM_LMDZ,ierr)
    185185   
    186186    deallocate(tmp_table)

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

    r630 r764  
    3131      INTEGER l, ij ,ije,ijb,jje,jjb
    3232
    33       EXTERNAL filtreg_p
    34 
    3533
    3634      ijb=ij_begin-iip1
    … …  
    4543
    4644c    ........  Calcul du rotationnel du vent V  puis filtrage  ........
    47 
     45c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    4846      DO 5 l = 1,llm
    4947
    … …  
    6563
    6664   5  CONTINUE
    67 
     65c$OMP END DO NOWAIT
    6866      jjb=jj_begin-1
    6967      jje=jj_end
    … …  
    7371      CALL  filtreg_p( rot, jjb,jje,jjm, llm, 2, 1, .FALSE., 1 )
    7472
    75      
     73c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    7674      DO 10 l = 1, llm
    7775     
    … …  
    9189
    9290  10  CONTINUE
    93 
     91c$OMP END DO NOWAIT
    9492      RETURN
    9593      END

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

    r630 r764  
    3838     
    3939      if (pole_sud) ije=ij_end
    40      
     40c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    4141      DO 2  l = 1,llmm1
    4242
    … …  
    4646
    4747   2  CONTINUE
    48 
     48c$OMP END DO
     49c$OMP MASTER
    4950      DO 5 ij  = ijb,ije
    5051      w(ij,1)  = 0.
    51525     CONTINUE
    52 
     53c$OMP END MASTER
     54c$OMP BARRIER
    5355      RETURN
    5456      END

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

    r630 r764  
    228228      REAL u_mq(ip1jmp1,llm)
    229229
    230       Logical extremum,first,testcpu
    231       SAVE first,testcpu
     230      Logical extremum
    232231
    233232      REAL      SSUM
    234233      EXTERNAL  SSUM
    235       REAL temps0,temps1,temps2,temps3,temps4,temps5,second
    236       SAVE temps0,temps1,temps2,temps3,temps4,temps5
    237234
    238235      REAL z1,z2,z3
    239236
    240       DATA first,testcpu/.true.,.false./
    241237      INTEGER ijb,ije,ijb_x,ije_x
    242238     
    243       IF(first) THEN
    244          temps1=0.
    245          temps2=0.
    246          temps3=0.
    247          temps4=0.
    248          temps5=0.
    249          first=.false.
    250       ENDIF
    251 
    252239c   calcul de la pente a droite et a gauche de la maille
    253240
    … …  
    265252
    266253c   calcul de la pente aux points u
    267          
     254c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)         
    268255         DO l = 1, llm
    269256           
    … …  
    315302
    316303         ENDDO ! l=1,llm
     304c$OMP END DO NOWAIT
    317305c       print*,'Ok calcul des pentes'
    318306
    … …  
    321309c   Pentes produits:
    322310c   ----------------
    323 
     311c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    324312         DO l = 1, llm
    325313            DO ij=ijb,ije-1
    … …  
    342330
    343331         ENDDO
    344 
     332c$OMP END DO NOWAIT
    345333      ENDIF ! (pente_max.lt.-1.e-5)
    346334
    347335c   bouclage de la pente en iip1:
    348336c   -----------------------------
    349 
     337c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    350338      DO l=1,llm
    351339         DO ij=ijb+iip1-1,ije,iip1
    352340            dxq(ij-iim,l)=dxq(ij,l)
    353341         ENDDO
    354          DO ij=1,ip1jmp1
     342         DO ij=ijb,ije
    355343            iadvplus(ij,l)=0
    356344         ENDDO
    357345
    358346      ENDDO
    359 
     347c$OMP END DO NOWAIT
    360348c        print*,'Bouclage en iip1'
    361349
    … …  
    363351
    364352#ifdef CRAY
    365 
     353c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    366354      DO l=1,llm
    367355       DO ij=ijb,ije-1
    … …  
    377365       ENDDO
    378366      ENDDO
     367c$OMP END DO NOWAIT
    379368#else
    380369c   on cumule le flux correspondant a toutes les mailles dont la masse
    381370c   au travers de la paroi pENDant le pas de temps.
    382371c       print*,'Cumule ....'
    383 
     372c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    384373      DO l=1,llm
    385374       DO ij=ijb,ije-1
    … …  
    394383       ENDDO
    395384      ENDDO
     385c$OMP END DO NOWAIT
    396386#endif
    397387c       stop
    … …  
    400390c   detection des points ou on advecte plus que la masse de la
    401391c   maille
     392c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    402393      DO l=1,llm
    403394         DO ij=ijb,ije-1
    … …  
    408399         ENDDO
    409400      ENDDO
     401c$OMP END DO NOWAIT
    410402c       print*,'Ok test 1'
     403c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    411404      DO l=1,llm
    412405       DO ij=ijb+iip1-1,ije,iip1
    … …  
    414407       ENDDO
    415408      ENDDO
     409c$OMP END DO NOWAIT
    416410c        print*,'Ok test 2'
    417411
    … …  
    424418
    425419      n0=0
     420c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    426421      DO l=1,llm
    427422         nl(l)=0
    … …  
    431426         n0=n0+nl(l)
    432427      ENDDO
    433 
     428c$OMP END DO NOWAIT
    434429cym      IF(n0.gt.1) THEN
    435       IF(n0.gt.0) THEN
     430cym      IF(n0.gt.0) THEN
    436431
    437432c      PRINT*,'Nombre de points pour lesquels on advect plus que le'
    438433c     &       ,'contenu de la maille : ',n0
    439 
     434c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    440435         DO l=1,llm
    441436            IF(nl(l).gt.0) THEN
    … …  
    487482            ENDIF
    488483         ENDDO
    489       ENDIF  ! n0.gt.0
     484c$OMP END DO NOWAIT
     485cym      ENDIF  ! n0.gt.0
    4904869999    continue
    491487
    … …  
    493489c   bouclage en latitude
    494490c       print*,'Avant bouclage en latitude'
     491c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    495492      DO l=1,llm
    496493        DO ij=ijb+iip1-1,ije,iip1
    … …  
    498495        ENDDO
    499496      ENDDO
    500 
     497c$OMP END DO NOWAIT
    501498
    502499c   calcul des tENDances
    503 
     500c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    504501      DO l=1,llm
    505502         DO ij=ijb+1,ije
    … …  
    516513         ENDDO
    517514      ENDDO
     515c$OMP END DO NOWAIT
    518516c     CALL SCOPY((jjm-1)*llm,q(iip1+iip1,1),iip1,q(iip2,1),iip1)
    519517c     CALL SCOPY((jjm-1)*llm,masse(iip1+iip1,1),iip1,masse(iip2,1),iip1)
    … …  
    568566      REAL temps0,temps1,temps2,temps3,temps4,temps5,second
    569567      SAVE temps0,temps1,temps2,temps3,temps4,temps5
     568c$OMP THREADPRIVATE(temps0,temps1,temps2,temps3,temps4,temps5)
    570569      SAVE first,testcpu
     570c$OMP THREADPRIVATE(first,testcpu)
    571571
    572572      REAL convpn,convps,convmpn,convmps
    … …  
    575575      REAL coslon(iip1),coslondlon(iip1)
    576576      SAVE sinlon,coslon,sinlondlon,coslondlon
     577c$OMP THREADPRIVATE(sinlon,coslon,sinlondlon,coslondlon)
    577578      SAVE airej2,airejjm
     579c$OMP THREADPRIVATE(airej2,airejjm)
    578580c
    579581c
    … …  
    605607c       PRINT*,'CALCUL EN LATITUDE'
    606608
    607      
     609c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    608610      DO l = 1, llm
    609611c
    … …  
    806808
    807809      ENDDO
     810c$OMP END DO NOWAIT
    808811
    809812      ijb=ij_begin-iip1
    … …  
    812815      if (pole_sud)  ije=ij_end-iip1
    813816
    814 
     817c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    815818      DO l=1,llm
    816819       DO ij=ijb,ije
    … …  
    825828       ENDDO
    826829      ENDDO
    827 
     830c$OMP END DO NOWAIT
    828831     
    829832      ijb=ij_begin
    … …  
    832835      if (pole_sud)  ije=ij_end-iip1
    833836     
     837c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    834838      DO l=1,llm
    835839         DO ij=ijb,ije
    … …  
    900904c._. fin nouvelle version
    901905      ENDDO
     906c$OMP END DO NOWAIT
    902907
    903908      RETURN
    … …  
    939944      INTEGER i,ij,l,j,ii
    940945c
    941       REAL wq(ip1jmp1,llm+1),newmasse
    942 
    943       REAL dzq(ip1jmp1,llm),dzqw(ip1jmp1,llm),adzqw(ip1jmp1,llm),dzqmax
     946      REAL,SAVE :: wq(ip1jmp1,llm+1)
     947      REAL newmasse
     948
     949      REAL,SAVE :: dzq(ip1jmp1,llm),dzqw(ip1jmp1,llm),adzqw(ip1jmp1,llm)
     950      REAL dzqmax
    944951      REAL sigw
    945952
    946953      LOGICAL testcpu
    947954      SAVE testcpu
    948 
     955c$OMP THREADPRIVATE(testcpu)
    949956      REAL temps0,temps1,temps2,temps3,temps4,temps5,second
    950957      SAVE temps0,temps1,temps2,temps3,temps4,temps5
     958c$OMP THREADPRIVATE(temps0,temps1,temps2,temps3,temps4,temps5)
     959
    951960      REAL      SSUM
    952       EXTERNAL  SSUM, convflu
    953       EXTERNAL filtreg
     961      EXTERNAL  SSUM
    954962
    955963      DATA testcpu/.false./
    … …  
    967975      ijb=ijb_x
    968976      ije=ije_x
    969      
     977
     978c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    970979      DO l=2,llm
    971980         DO ij=ijb,ije
    … …  
    974983         ENDDO
    975984      ENDDO
    976 
     985c$OMP END DO
     986
     987c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    977988      DO l=2,llm-1
    978989         DO ij=ijb,ije
    … …  
    9911002         ENDDO
    9921003      ENDDO
    993 
     1004c$OMP END DO NOWAIT
     1005
     1006c$OMP MASTER
    9941007      DO ij=ijb,ije
    9951008         dzq(ij,1)=0.
    9961009         dzq(ij,llm)=0.
    9971010      ENDDO
    998 
     1011c$OMP END MASTER
     1012c$OMP BARRIER
    9991013#ifdef BIDON
    10001014      IF(testcpu) THEN
    … …  
    10081022c calcul de  - d( q   * w )/ d(sigma)    qu'on ajoute a  dq pour calculer dq
    10091023
     1024c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    10101025       DO l = 1,llm-1
    10111026         do  ij = ijb,ije
    … …  
    10191034         ENDDO
    10201035       ENDDO
    1021 
     1036c$OMP END DO NOWAIT
     1037
     1038c$OMP MASTER
    10221039       DO ij=ijb,ije
    10231040          wq(ij,llm+1)=0.
    10241041          wq(ij,1)=0.
    10251042       ENDDO
    1026 
     1043c$OMP END MASTER
     1044c$OMP BARRIER
     1045
     1046c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    10271047      DO l=1,llm
    10281048         DO ij=ijb,ije
    … …  
    10331053         ENDDO
    10341054      ENDDO
     1055c$OMP END DO NOWAIT
    10351056
    10361057

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

    r630 r764  
    260260      REAL u_mq(ip1jmp1,llm)
    261261
    262       Logical first,testcpu
    263       SAVE first,testcpu
    264 
    265262      REAL      SSUM
    266       REAL temps0,temps1,temps2,temps3,temps4,temps5
    267       SAVE temps0,temps1,temps2,temps3,temps4,temps5
    268 
    269 
    270       DATA first,testcpu/.true.,.false./
     263
    271264
    272265      INTEGER ijb,ije,ijb_x,ije_x
    273266     
    274       IF(first) THEN
    275          temps1=0.
    276          temps2=0.
    277          temps3=0.
    278          temps4=0.
    279          temps5=0.
    280          first=.false.
    281       ENDIF
    282267
    283268c   calcul de la pente a droite et a gauche de la maille
    … …  
    299284
    300285c   calcul de la pente aux points u
     286
     287c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    301288         DO l = 1, llm
    302289            DO ij=ijb,ije-1
    … …  
    347334
    348335         ENDDO ! l=1,llm
     336c$OMP END DO NOWAIT
    349337
    350338      ELSE ! (pente_max.lt.-1.e-5)
    … …  
    352340c   Pentes produits:
    353341c   ----------------
    354 
     342c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    355343         DO l = 1, llm
    356344            DO ij=ijb,ije-1
    … …  
    373361
    374362         ENDDO
    375 
     363c$OMP END DO NOWAIT
    376364      ENDIF ! (pente_max.lt.-1.e-5)
    377365
    378366c   bouclage de la pente en iip1:
    379367c   -----------------------------
    380 
     368c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    381369      DO l=1,llm
    382370         DO ij=ijb+iip1-1,ije,iip1
    … …  
    389377
    390378      ENDDO
    391      
    392       if (pole_nord) iadvplus(1:iip1,1:llm)=0
    393       if (pole_sud)  iadvplus(ip1jm+1:ip1jmp1,1:llm)=0
    394 
     379c$OMP END DO NOWAIT
     380     
     381      if (pole_nord) THEN
     382c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     383        DO l=1,llm     
     384          iadvplus(1:iip1,l)=0
     385        ENDDO
     386c$OMP END DO NOWAIT
     387      endif
     388     
     389      if (pole_sud)  THEN
     390c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     391        DO l=1,llm
     392          iadvplus(ip1jm+1:ip1jmp1,l)=0
     393        ENDDO
     394c$OMP END DO NOWAIT
     395      endif
     396       
    395397c   calcul des flux a gauche et a droite
    396398
    397399#ifdef CRAY
    398400c--pas encore modification sur Qsat
     401c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    399402      DO l=1,llm
    400403       DO ij=ijb,ije-1
    … …  
    410413       ENDDO
    411414      ENDDO
     415c$OMP END DO NOWAIT
     416
    412417#else
    413418c   on cumule le flux correspondant a toutes les mailles dont la masse
    414419c   au travers de la paroi pENDant le pas de temps.
    415420c   le rapport de melange de l'air advecte est min(q_vanleer, Qsat_downwind)
     421c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    416422      DO l=1,llm
    417423       DO ij=ijb,ije-1
    … …  
    427433       ENDDO
    428434      ENDDO
     435c$OMP END DO NOWAIT
    429436#endif
    430437
    … …  
    432439c   detection des points ou on advecte plus que la masse de la
    433440c   maille
     441c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    434442      DO l=1,llm
    435443         DO ij=ijb,ije-1
    … …  
    440448         ENDDO
    441449      ENDDO
     450c$OMP END DO NOWAIT
     451
     452c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    442453      DO l=1,llm
    443454       DO ij=ijb+iip1-1,ije,iip1
    … …  
    445456       ENDDO
    446457      ENDDO
     458c$OMP END DO NOWAIT
    447459
    448460
    … …  
    457469
    458470      n0=0
     471c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    459472      DO l=1,llm
    460473         nl(l)=0
    … …  
    464477         n0=n0+nl(l)
    465478      ENDDO
    466 
     479c$OMP END DO NOWAIT
     480
     481cym ATTENTION ICI en OpenMP reduction pas forcement nécessaire
    467482cym      IF(n0.gt.1) THEN
    468         IF(n0.gt.0) THEN
     483cym        IF(n0.gt.0) THEN
    469484ccc      PRINT*,'Nombre de points pour lesquels on advect plus que le'
    470485ccc     &       ,'contenu de la maille : ',n0
    471 
     486c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    472487         DO l=1,llm
    473488            IF(nl(l).gt.0) THEN
    … …  
    519534            ENDIF
    520535         ENDDO
    521       ENDIF  ! n0.gt.0
     536c$OMP END DO NOWAIT
     537cym      ENDIF  ! n0.gt.0
    522538
    523539
    524540
    525541c   bouclage en latitude
    526 
     542c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    527543      DO l=1,llm
    528544        DO ij=ijb+iip1-1,ije,iip1
    … …  
    530546        ENDDO
    531547      ENDDO
    532 
     548c$OMP END DO NOWAIT
    533549
    534550c   calcul des tendances
    535 
     551c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    536552      DO l=1,llm
    537553         DO ij=ijb+1,ije
    … …  
    548564         ENDDO
    549565      ENDDO
    550 
     566c$OMP END DO NOWAIT
    551567c     CALL SCOPY((jjm-1)*llm,q(iip1+iip1,1),iip1,q(iip2,1),iip1)
    552568c     CALL SCOPY((jjm-1)*llm,masse(iip1+iip1,1),iip1,masse(iip2,1),iip1)
    … …  
    597613      REAL qpns,qpsn,dyn1,dys1,dyn2,dys2,newmasse,fn,fs
    598614c     REAL newq,oldmasse
    599       Logical first,testcpu
    600       REAL temps0,temps1,temps2,temps3,temps4,temps5
    601       SAVE temps0,temps1,temps2,temps3,temps4,temps5
    602       SAVE first,testcpu
    603 
     615      Logical first
     616      SAVE first
     617c$OMP THREADPRIVATE(first)
    604618      REAL convpn,convps,convmpn,convmps
    605619      REAL sinlon(iip1),sinlondlon(iip1)
    … …  
    607621      SAVE sinlon,coslon,sinlondlon,coslondlon
    608622      SAVE airej2,airejjm
     623c$OMP THREADPRIVATE(sinlon,coslon,sinlondlon,coslondlon)
     624c$OMP THREADPRIVATE(airej2,airejjm)
    609625c
    610626c
    611627      REAL      SSUM
    612628
    613       DATA first,testcpu/.true.,.false./
    614       DATA temps0,temps1,temps2,temps3,temps4,temps5/0.,0.,0.,0.,0.,0./
     629      DATA first/.true./
    615630      INTEGER ijb,ije
    616631
    … …  
    634649c
    635650
    636 
     651c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    637652      DO l = 1, llm
    638653c
    … …  
    833848
    834849      ENDDO
     850c$OMP END DO NOWAIT
    835851
    836852      ijb=ij_begin-iip1
    … …  
    839855      if (pole_sud)  ije=ij_end-iip1
    840856
     857c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    841858      DO l=1,llm
    842859       DO ij=ijb,ije
    … …  
    851868       ENDDO
    852869      ENDDO
     870c$OMP END DO NOWAIT
    853871
    854872      ijb=ij_begin
    … …  
    856874      if (pole_nord) ijb=ij_begin+iip1
    857875      if (pole_sud)  ije=ij_end-iip1
    858      
     876
     877c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    859878      DO l=1,llm
    860879         DO ij=ijb,ije
    … …  
    917936c._. fin nouvelle version
    918937      ENDDO
    919 
     938c$OMP END DO NOWAIT
    920939      RETURN
    921940      END
Note: See TracChangeset for help on using the changeset viewer.