Changeset 985 for LMDZ4/trunk


Ignore:
Timestamp:
Jul 30, 2008, 5:50:03 PM (16 years ago)
Author:
Laurent Fairhead
Message:

Mise a jour de dyn3dpar par rapport a dyn3d, inclusion OpenMP et filtre FFT YM
LF

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

Legend:

Unmodified
Added
Removed

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

    r949 r985  
    2525      write(lunout,*) 'in abort_gcm'
    2626#ifdef CPP_IOIPSL
     27c$OMP MASTER
    2728      call histclo
    2829      call restclo
     30c$OMP END MASTER
    2931#endif
    3032c     call getin_dump
    … …  
    3941      else
    4042        write(lunout,*) 'Houston, we have a problem ', ierr
     43      STOP
    4144      endif
    42       STOP
    4345      END

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

    r960 r985  
    8282      DATA fill/.true./
    8383      DATA dum/.true./
    84       REAL finmasse(ip1jmp1,llm)
     84      REAL,SAVE :: finmasse(ip1jmp1,llm)
    8585      integer ijb,ije,ijb_u,ijb_v,ije_u,ije_v,j
    8686      type(Request) :: Request_vanleer
    … …  
    161161c     2. groupement des mailles pres du pole.
    162162
    163 c$OMP BARRIER
    164163        CALL groupe_p( massem, pbaruc,pbarvc, pbarug,pbarvg,wg )
    165 c$OMP BARRIER
    166 
    167 c$OMP BARRIER
    168 c$OMP MASTER     
    169       p_tmp(ijb:ije,1:llmp1)=p(ijb:ije,1:llmp1)
    170       pk_tmp(ijb:ije,1:llm)=pk(ijb:ije,1:llm)
    171       teta_tmp(ijb:ije,1:llm)=teta(ijb:ije,1:llm)
     164
     165c$OMP BARRIER
     166
     167c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     168      DO l=1,llmp1
     169        p_tmp(ijb:ije,l)=p(ijb:ije,l)
     170      ENDDO
     171c$OMP END DO NOWAIT
     172     
     173c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     174      DO l=1,llm
     175        pk_tmp(ijb:ije,l)=pk(ijb:ije,l)
     176        teta_tmp(ijb:ije,l)=teta(ijb:ije,l)
     177      ENDDO
     178c$OMP END DO NOWAIT
     179
     180c$OMP MASTER
    172181      call VTb(VTHallo)
     182c$OMP END MASTER
     183
    173184      call Register_SwapFieldHallo(pbarug,pbarug,ip1jmp1,llm,
    174185     *                             jj_Nb_vanleer,0,0,Request_vanleer)
    … …  
    189200     *                             jj_nb_vanleer,0,0,Request_vanleer)
    190201      enddo
    191      
     202
     203      call SendRequest(Request_vanleer)
     204c$OMP BARRIER
     205      call WaitRequest(Request_vanleer)
     206
     207
     208c$OMP BARRIER
     209c$OMP MASTER     
    192210      call SetDistrib(jj_nb_vanleer)
    193       call SendRequest(Request_vanleer)
    194       call WaitRequest(Request_vanleer)
    195 
    196211      call VTe(VTHallo)
    197      
    198212      call VTb(VTadvection)
    199213      call start_timer(timer_vanleer)
    … …  
    4404541234  CONTINUE
    441455c$OMP BARRIER
    442 c$OMP MASTER
     456
    443457      ijb=ij_begin
    444458      ije=ij_end
    445      
     459
     460c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    446461       DO l = 1, llm
    447462         DO ij = ijb, ije
    … …  
    449464         ENDDO
    450465       ENDDO
    451 
     466c$OMP END DO
    452467
    453468       CALL qminimum_p( q, 2, finmasse )
    … …  
    457472c---------------------------------------------------
    458473c          iadvtr=0
     474
     475c$OMP MASTER
    459476        call VTe(VTadvection)
    460477        call stop_timer(timer_vanleer)
    461 
    462478        call VTb(VThallo)
     479c$OMP END MASTER
     480
    463481        do j=1,nqmx
    464482          call Register_SwapFieldHallo(q(1,1,j),q(1,1,j),ip1jmp1,llm,
    … …  
    469487     *       jj_nb_caldyn,0,0,Request_vanleer)
    470488
     489        call SendRequest(Request_vanleer)
     490c$OMP BARRIER
     491        call WaitRequest(Request_vanleer)     
     492
     493c$OMP BARRIER
     494c$OMP MASTER
    471495        call SetDistrib(jj_nb_caldyn)
    472         call SendRequest(Request_vanleer)
    473         call WaitRequest(Request_vanleer)     
    474        
    475496        call VTe(VThallo)
    476497        call resume_timer(timer_caldyn)

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

    r764 r985  
    164164      type(Request) :: Req
    165165
     166! definition du domaine d'ecriture pour le rebuild
     167
     168      INTEGER,DIMENSION(1) :: ddid
     169      INTEGER,DIMENSION(1) :: dsg
     170      INTEGER,DIMENSION(1) :: dsl
     171      INTEGER,DIMENSION(1) :: dpf
     172      INTEGER,DIMENSION(1) :: dpl
     173      INTEGER,DIMENSION(1) :: dhs
     174      INTEGER,DIMENSION(1) :: dhe
     175     
     176      INTEGER :: bilan_dyn_domain_id
     177
    166178
    167179c=====================================================================
    … …  
    233245      jje=jj_end
    234246      jjn=jj_nb
    235       if (pole_sud) jjn=jj_nb-1
     247      IF (pole_sud) THEN
     248        jjn=jj_nb-1
     249        jje=jj_end-1
     250      ENDIF
     251
     252      ddid=(/ 2 /)
     253      dsg=(/ jjm /)
     254      dsl=(/ jjn /)
     255      dpf=(/ jjb /)
     256      dpl=(/ jje /)
     257      dhs=(/ 0 /)
     258      dhe=(/ 0 /)
     259
     260      call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,
     261     .                 'box',bilan_dyn_domain_id)
    236262       
    237       call histbeg(trim(infile)//'_'//trim(int2str(mpi_rank)),
     263      call histbeg(trim(infile),
    238264     .             1, rlong(jjb:jje), jjn, rlatg(jjb:jje),
    239265     .             1, 1, 1, jjn,
    240      .             tau0, zjulian, dt_cum, thoriid, fileid)
     266     .             tau0, zjulian, dt_cum, thoriid, fileid,
     267     .             bilan_dyn_domain_id)
    241268
    242269C
    … …  
    352379c
    353380      if(icum.EQ.0) then
    354          ps_cum=0.
    355          masse_cum=0.
    356          flux_u_cum=0.
    357          flux_v_cum=0.
    358          Q_cum=0.
    359          flux_vQ_cum=0.
    360          flux_uQ_cum=0.
     381         jjb=jj_begin
     382         jje=jj_end
     383
     384         ps_cum(:,jjb:jje)=0.
     385         masse_cum(:,jjb:jje,:)=0.
     386         flux_u_cum(:,jjb:jje,:)=0.
     387         Q_cum(:,jjb:jje,:,:)=0.
     388         flux_uQ_cum(:,jjb:jje,:,:)=0.
     389         flux_v_cum(:,jjb:jje,:)=0.
     390         if (pole_sud) jje=jj_end-1
     391         flux_v_cum(:,jjb:jje,:)=0.
     392         flux_vQ_cum(:,jjb:jje,:,:)=0.
    361393      endif
    362394
    … …  
    366398
    367399c   accumulation des flux de masse horizontaux
    368       ps_cum=ps_cum+ps
    369       masse_cum=masse_cum+masse
    370       flux_u_cum=flux_u_cum+flux_u
    371       flux_v_cum=flux_v_cum+flux_v
     400      jjb=jj_begin
     401      jje=jj_end
     402
     403      ps_cum(:,jjb:jje)=ps_cum(:,jjb:jje)+ps(:,jjb:jje)
     404      masse_cum(:,jjb:jje,:)=masse_cum(:,jjb:jje,:)+masse(:,jjb:jje,:)
     405      flux_u_cum(:,jjb:jje,:)=flux_u_cum(:,jjb:jje,:)
     406     .                       +flux_u(:,jjb:jje,:)
     407      if (pole_sud) jje=jj_end-1
     408      flux_v_cum(:,jjb:jje,:)=flux_v_cum(:,jjb:jje,:)
     409     .                         +flux_v(:,jjb:jje,:)
     410
     411      jjb=jj_begin
     412      jje=jj_end
     413
    372414      do iQ=1,nQ
    373415        Q_cum(:,jjb:jje,:,iQ)=Q_cum(:,jjb:jje,:,iQ)
    … …  
    396438c    -------------
    397439      do iQ=1,nQ
     440        call Register_Hallo(Q(1,1,1,iQ),ip1jmp1,llm,0,1,1,0,Req)
     441      enddo
     442      call SendRequest(Req)
     443      call WaitRequest(Req)
     444     
     445      jjb=jj_begin
     446      jje=jj_end
     447      if (pole_sud) jje=jj_end-1
     448     
     449      do iQ=1,nQ
    398450         do l=1,llm
    399451            do j=jjb,jje
    … …  
    426478      call convmas_p(flux_u_cum,flux_v_cum,convm)
    427479      CALL vitvert_p(convm,w)
     480
     481      jjb=jj_begin
     482      jje=jj_end
    428483
    429484      do iQ=1,nQ
    … …  
    455510      enddo
    456511      zz=1./float(ncum)
    457       ps_cum=ps_cum*zz
    458       masse_cum=masse_cum*zz
    459       flux_u_cum=flux_u_cum*zz
    460       flux_v_cum=flux_v_cum*zz
    461       flux_uQ_cum=flux_uQ_cum*zz
    462       flux_vQ_cum=flux_vQ_cum*zz
    463       dQ=dQ*zz
     512
     513      jjb=jj_begin
     514      jje=jj_end
     515
     516      ps_cum(:,jjb:jje)=ps_cum(:,jjb:jje)*zz
     517      masse_cum(:,jjb:jje,:)=masse_cum(:,jjb:jje,:)*zz
     518      flux_u_cum(:,jjb:jje,:)=flux_u_cum(:,jjb:jje,:)*zz
     519      flux_uQ_cum(:,jjb:jje,:,:)=flux_uQ_cum(:,jjb:jje,:,:)*zz
     520      dQ(:,jjb:jje,:,:)=dQ(:,jjb:jje,:,:)*zz
     521     
     522      IF (pole_sud) jje=jj_end-1
     523      flux_v_cum(:,jjb:jje,:)=flux_v_cum(:,jjb:jje,:)*zz
     524      flux_vQ_cum(:,jjb:jje,:,:)=flux_vQ_cum(:,jjb:jje,:,:)*zz
     525
     526      jjb=jj_begin
     527      jje=jj_end
    464528
    465529
    … …  
    476540c   cumul zonal des masses des mailles
    477541c   ----------------------------------
    478       zv=0.
    479       zmasse=0.
    480       call massbar(masse_cum,massebx,masseby)
     542      jjb=jj_begin
     543      jje=jj_end
     544      if (pole_sud) jje=jj_end-1
     545
     546      zv(jjb:jje,:)=0.
     547      zmasse(jjb:jje,:)=0.
     548
     549      call Register_Hallo(masse_cum,ip1jmp1,llm,1,1,1,1,Req)
     550      do iQ=1,nQ
     551        call Register_Hallo(Q_cum(1,1,1,iQ),ip1jmp1,llm,0,1,1,0,Req)
     552      enddo
     553
     554      call SendRequest(Req)
     555      call WaitRequest(Req)
     556
     557      call massbar_p(masse_cum,massebx,masseby)
    481558     
    482559      jjb=jj_begin
    … …  
    524601c   ----------------------------------------
    525602
     603      jjb=jj_begin
     604      jje=jj_end
     605      if (pole_sud) jje=jj_end-1
     606     
    526607      zvQ=0.
    527608      psiQ=0.
    … …  
    560641
    561642c   fonction de courant pour la circulation meridienne moyenne
    562       psi=0.
     643      psi(jjb:jje,:)=0.
    563644      do l=llm,1,-1
    564645         do j=jjb,jje
    … …  
    588669      enddo
    589670
    590       call histwrite(fileid,'masse',itau,zmasse(jjb:jje,1)
     671      call histwrite(fileid,'masse',itau,zmasse(jjb:jje,1:llm)
    591672     s   ,jjn*llm,ndex3d)
    592       call histwrite(fileid,'v',itau,zv(jjb:jje,1)
     673      call histwrite(fileid,'v',itau,zv(jjb:jje,1:llm)
    593674     s   ,jjn*llm,ndex3d)
    594       psi=psi*1.e-9
     675      psi(jjb:jje,:)=psi(jjb:jje,:)*1.e-9
    595676      call histwrite(fileid,'psi',itau,psi(jjb:jje,1:llm),
    596677     s               jjn*llm,ndex3d)
    … …  
    603684c   -----------------
    604685
    605       zamasse=0.
     686      zamasse(jjb:jje)=0.
    606687      do l=1,llm
    607688         zamasse(jjb:jje)=zamasse(jjb:jje)+zmasse(jjb:jje,l)
    608689      enddo
    609       zavQ=0.
     690     
     691      zavQ(jjb:jje,:,:)=0.
    610692      do iQ=1,nQ
    611693         do itr=2,ntr

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

    r961 r985  
    161161      REAL,ALLOCATABLE,SAVE :: zdtfi(:,:),zdqfi(:,:,:)
    162162      REAL,ALLOCATABLE,SAVE :: zdpsrf(:)
     163      REAL,SAVE,ALLOCATABLE ::  flxwfi(:,:)     ! Flux de masse verticale sur la grille physiq
     164
    163165c
    164166      REAL,ALLOCATABLE,SAVE :: zplev_omp(:,:)
    … …  
    177179      REAL,ALLOCATABLE,SAVE :: zdqfi_omp(:,:,:)
    178180      REAL,ALLOCATABLE,SAVE :: zdpsrf_omp(:)
     181      REAL,SAVE,ALLOCATABLE ::  flxwfi_omp(:,:)     ! Flux de masse verticale sur la grille physiq
    179182
    180183c$OMP THREADPRIVATE(zplev_omp,zplay_omp,zphi_omp,zphis_omp,
    181184c$OMP+                 presnivs_omp,zufi_omp,zvfi_omp,ztfi_omp,
    182 c$OMP+                 zqfi_omp,pvervel_omp,zdufi_omp,zdvfi_omp,
    183 c$OMP+                 zdtfi_omp,zdqfi_omp,zdpsrf_omp)       
     185c$OMP+                 zqfi_omp,zdufi_omp,zdvfi_omp,
     186c$OMP+                 zdtfi_omp,zdqfi_omp,zdpsrf_omp,flxwfi_omp)       
    184187
    185188      LOGICAL,SAVE :: first_omp=.true.
    … …  
    198201     
    199202      REAL flxw(iip1,jjp1,llm)  ! Flux de masse verticale sur la grille dynamique
    200       REAL flxwfi(klon,llm)     ! Flux de masse verticale sur la grille physiq
    201203     
    202204      REAL SSUM
    … …  
    254256      ALLOCATE(zdpsrf(klon))
    255257      ALLOCATE(zdufi2(klon+iim,llm),zdvfi2(klon+iim,llm))
     258      ALLOCATE(flxwfi(klon,llm))
    256259c$OMP END MASTER
    257260c$OMP BARRIER     
    … …  
    548551        allocate(zdqfi_omp(klon,llm,nq))
    549552        allocate(zdpsrf_omp(klon))
     553        allocate(flxwfi_omp(klon,llm))
    550554        first_omp=.false.
    551555      endif
    … …  
    643647        zdpsrf_omp(i)=zdpsrf(offset+i)
    644648      enddo
     649
     650      do l=1,llm
     651        do i=1,klon
     652          flxwfi_omp(i,l)=flxwfi(offset+i,l)
     653        enddo
     654      enddo
    645655     
    646656c$OMP BARRIER
    … …  
    667677c     .             pvervel_omp,
    668678c#ifdef INCA
    669      .             flxwfi,
     679     .             flxwfi_omp,
    670680c#endif
    671681     .             zdufi_omp,
    … …  
    794804c$OMP BARRIER
    795805c$OMP MASTER
     806!$OMP CRITICAL (MPI)
    796807        call MPI_ISSEND(du_send,iim*llm,MPI_REAL8,MPI_Rank-1,401,
    797808     &                   COMM_LMDZ,Req(1),ierr)
    798809        call MPI_ISSEND(dv_send,iim*llm,MPI_REAL8,MPI_Rank-1,402,
    799810     &                  COMM_LMDZ,Req(2),ierr)
     811!$OMP END CRITICAL (MPI)
    800812c$OMP END MASTER
    801813c$OMP BARRIER
    … …  
    806818c$OMP BARRIER
    807819c$OMP MASTER     
     820!$OMP CRITICAL (MPI)
    808821        call MPI_IRECV(du_recv,iim*llm,MPI_REAL8,MPI_Rank+1,401,
    809822     &                 COMM_LMDZ,Req(3),ierr)
    810823        call MPI_IRECV(dv_recv,iim*llm,MPI_REAL8,MPI_Rank+1,402,
    811824     &                 COMM_LMDZ,Req(4),ierr)
     825!$OMP END CRITICAL (MPI)
    812826c$OMP END MASTER
    813827c$OMP BARRIER     
    … …  
    816830c$OMP BARRIER
    817831c$OMP MASTER   
     832!$OMP CRITICAL (MPI)
    818833      if (MPI_rank>0 .and. MPI_rank< MPI_Size-1) then
    819834        call MPI_WAITALL(4,Req(1),Status,ierr)
    … …  
    823838        call MPI_WAITALL(2,Req(3),Status,ierr)
    824839      endif
     840!$OMP END CRITICAL (MPI)
    825841c$OMP END MASTER
    826842c$OMP BARRIER     

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

    r960 r985  
    88      use IOIPSL
    99      use misc_mod
     10      use mod_filtre_fft, ONLY : use_filtre_fft
     11      use mod_hallo, ONLY : use_mpi_alloc
     12      use parallel, ONLY : omp_chunk
    1013      IMPLICIT NONE
    1114c-----------------------------------------------------------------------
    … …  
    3437#include "serre.h"
    3538#include "comdissnew.h"
    36 #include "clesphys.h"
     39!#include "clesphys.h"
    3740#include "iniprint.h"
     41
     42! FH 2008/05/09 On elimine toutes les clefs physiques dans la dynamique
    3843c
    3944c
    … …  
    298303c
    299304
    300 !Config  Key  = ecritphy
    301 !Config  Desc = Frequence d'ecriture de la physique
    302 !Config  Def  = 1
    303 !Config  Help = frequence  de l'ecriture du fichier histphy
    304 !Config         en jours.
    305        ecritphy = 1
    306        CALL getin('ecritphy',ecritphy)
    307 
    308 !Config  Key  = cycle_diurne
    309 !Config  Desc = Cycle ddiurne
    310 !Config  Def  = y
    311 !Config  Help = Cette option permet d'eteidre le cycle diurne.
    312 !Config         Peut etre util pour accelerer le code !
    313        cycle_diurne = .TRUE.
    314        CALL getin('cycle_diurne',cycle_diurne)
    315 
    316 !Config  Key  = soil_model
    317 !Config  Desc = Modele de sol
    318 !Config  Def  = y
    319 !Config  Help = Choix du modele de sol (Thermique ?)
    320 !Config         Option qui pourait un string afin de pouvoir
    321 !Config         plus de choix ! Ou meme une liste d'options !
    322        soil_model = .TRUE.
    323        CALL getin('soil_model',soil_model)
    324 
    325 !Config  Key  = new_oliq
    326 !Config  Desc = Nouvelle eau liquide
    327 !Config  Def  = y
    328 !Config  Help = Permet de mettre en route la
    329 !Config         nouvelle parametrisation de l'eau liquide !
    330        new_oliq = .TRUE.
    331        CALL getin('new_oliq',new_oliq)
    332 
    333 !Config  Key  = ok_orodr
    334 !Config  Desc = Orodr ???
    335 !Config  Def  = y
    336 !Config  Help = Y en a pas comprendre !
    337 !Config         
    338        ok_orodr = .TRUE.
    339        CALL getin('ok_orodr',ok_orodr)
    340 
    341 !Config  Key  =  ok_orolf
    342 !Config  Desc = Orolf ??
    343 !Config  Def  = y
    344 !Config  Help = Connais pas !
    345        ok_orolf = .TRUE.
    346        CALL getin('ok_orolf', ok_orolf)
    347 
    348 !Config  Key  = ok_limitvrai
    349 !Config  Desc = Force la lecture de la bonne annee
    350 !Config  Def  = n
    351 !Config  Help = On peut forcer le modele a lire le
    352 !Config         fichier SST de la bonne annee. C'est une tres bonne
    353 !Config         idee, pourquoi ne pas mettre toujours a y ???
    354        ok_limitvrai = .FALSE.
    355        CALL getin('ok_limitvrai',ok_limitvrai)
    356 
    357 !Config  Key  = nbapp_rad
    358 !Config  Desc = Frequence d'appel au rayonnement
    359 !Config  Def  = 12
    360 !Config  Help = Nombre  d'appels des routines de rayonnements
    361 !Config         par jour.
    362        nbapp_rad = 12
    363        CALL getin('nbapp_rad',nbapp_rad)
    364 
    365 !Config  Key  = iflag_con
    366 !Config  Desc = Flag de convection
    367 !Config  Def  = 2
    368 !Config  Help = Flag  pour la convection les options suivantes existent :
    369 !Config         1 pour LMD,
    370 !Config         2 pour Tiedtke,
    371 !Config         3 pour CCM(NCAR) 
    372        iflag_con = 2
    373        CALL getin('iflag_con',iflag_con)
    374 !
     305
    375306!Config  Key  = ip_ebil_dyn
    376307!Config  Desc = PRINT level for energy conserv. diag.
    … …  
    384315       CALL getin('ip_ebil_dyn',ip_ebil_dyn)
    385316!
    386 
    387       DO i = 1, longcles
    388        clesphy0(i) = 0.
    389       ENDDO
    390                           clesphy0(1) = FLOAT( iflag_con )
    391                           clesphy0(2) = FLOAT( nbapp_rad )
    392 
    393        IF( cycle_diurne  ) clesphy0(3) =  1.
    394        IF(   soil_model  ) clesphy0(4) =  1.
    395        IF(     new_oliq  ) clesphy0(5) =  1.
    396        IF(     ok_orodr  ) clesphy0(6) =  1.
    397        IF(     ok_orolf  ) clesphy0(7) =  1.
    398        IF(  ok_limitvrai ) clesphy0(8) =  1.
    399317
    400318
    … …  
    633551      write(lunout,*)' purmats = ', purmats
    634552      write(lunout,*)' iflag_phys = ', iflag_phys
    635       write(lunout,*)' iphysiq = ', iphysiq
    636       write(lunout,*)' ecritphy = ', ecritphy
    637       write(lunout,*)' cycle_diurne = ', cycle_diurne
    638       write(lunout,*)' soil_model = ', soil_model
    639       write(lunout,*)' new_oliq = ', new_oliq
    640       write(lunout,*)' ok_orodr = ', ok_orodr
    641       write(lunout,*)' ok_orolf = ', ok_orolf
    642       write(lunout,*)' ok_limitvrai = ', ok_limitvrai
    643       write(lunout,*)' nbapp_rad = ', nbapp_rad
    644       write(lunout,*)' iflag_con = ', iflag_con
    645553      write(lunout,*)' clonn = ', clonn
    646554      write(lunout,*)' clatt = ', clatt
    … …  
    777685      CALL getin('config_inca',config_inca)
    778686
     687!Config  Key  = use_filtre_fft
     688!Config  Desc = flag d'activation des FFT pour le filtre
     689!Config  Def  = false
     690!Config  Help = permet d'activer l'utilisation des FFT pour effectuer
     691!Config         le filtrage aux poles.
     692      use_filtre_fft=.FALSE.
     693      CALL getin('use_filtre_fft',use_filtre_fft)
     694     
     695!Config  Key  = use_mpi_alloc
     696!Config  Desc = Utilise un buffer MPI en mémoire globale
     697!Config  Def  = false
     698!Config  Help = permet d'activer l'utilisation d'un buffer MPI
     699!Config         en mémoire globale a l'aide de la fonction MPI_ALLOC.
     700!Config         Cela peut améliorer la bande passante des transferts MPI
     701!Config         d'un facteur 2 
     702      use_mpi_alloc=.FALSE.
     703      CALL getin('use_mpi_alloc',use_mpi_alloc)
     704
     705!Config  Key  = omp_chunk
     706!Config  Desc = taille des blocs openmp
     707!Config  Def  = 1
     708!Config  Help = defini la taille des packets d'itération openmp
     709!Config         distribuée à chaque tâche lors de l'entrée dans une
     710!Config         boucle parallélisée
     711 
     712      omp_chunk=1
     713      CALL getin('omp_chunk',omp_chunk)
    779714
    780715      write(lunout,*)' #########################################'
    … …  
    799734      write(lunout,*)' purmats = ', purmats
    800735      write(lunout,*)' iflag_phys = ', iflag_phys
    801       write(lunout,*)' iphysiq = ', iphysiq
    802       write(lunout,*)' ecritphy = ', ecritphy
    803       write(lunout,*)' cycle_diurne = ', cycle_diurne
    804       write(lunout,*)' soil_model = ', soil_model
    805       write(lunout,*)' new_oliq = ', new_oliq
    806       write(lunout,*)' ok_orodr = ', ok_orodr
    807       write(lunout,*)' ok_orolf = ', ok_orolf
    808       write(lunout,*)' ok_limitvrai = ', ok_limitvrai
    809       write(lunout,*)' nbapp_rad = ', nbapp_rad
    810       write(lunout,*)' iflag_con = ', iflag_con
    811       write(lunout,*)' clonn = ', clonn
    812       write(lunout,*)' clatt = ', clatt
     736      write(lunout,*)' clon = ', clon
     737      write(lunout,*)' clat = ', clat
    813738      write(lunout,*)' grossismx = ', grossismx
    814739      write(lunout,*)' grossismy = ', grossismy
    … …  
    820745      write(lunout,*)' offline = ', offline
    821746      write(lunout,*)' config_inca = ', config_inca
     747      write(lunout,*)' use_filtre_fft = ', use_filtre_fft
     748      write(lunout,*)' use_mpi_alloc = ', use_mpi_alloc
     749      write(lunout,*)' omp_chunk = ', omp_chunk
    822750c
    823751      RETURN

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

    r960 r985  
    1313      COMMON/control/nday,day_step,                                     &
    1414     &              iperiod,iapp_tracvl,iconser,iecri,idissip,iphysiq , &
    15      &              periodav,ecritphy,iecrimoy,dayref,anneeref,         &
     15     &              periodav,iecrimoy,dayref,anneeref,                  &
    1616     &              raz_date,offline,ip_ebil_dyn,config_inca
    1717
    … …  
    1919     &          idissip,iphysiq,iecrimoy,dayref,anneeref, raz_date      &
    2020     &          ,ip_ebil_dyn
    21       REAL periodav, ecritphy
     21      REAL periodav
    2222      logical offline
    2323      CHARACTER*4 config_inca

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

    r774 r985  
    198198ccc   .... P.Le Van, ajout le 03/01/96 pour l'ecriture phys ...
    199199c
    200       READ (tapedef,9001) ch1,ch4
    201       READ (tapedef,*)    ecritphy
    202       WRITE(tapeout,9001) ch1,'ecritphy'
    203       WRITE(tapeout,*)    ecritphy
    204 
    205200      READ (tapedef,9001) ch1,ch4
    206201      READ (tapedef,*)    cycle_diurne

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

    r764 r985  
    9999      ENDIF
    100100
    101 c      call write_field3d_p('gdx',reshape(gdx,(/iip1,jjp1,llm/)))
    102 c     call write_field3d_p('gdy',reshape(gdy,(/iip1,jjm,llm/)))
    103 c       stop
    104101
    105102      ijb=ij_begin
    … …  
    143140      ENDIF
    144141
    145 c      call write_field3d_p('grx',reshape(grx,(/iip1,jjp1,llm/)))
    146 c      call write_field3d_p('gry',reshape(gry,(/iip1,jjm,llm/)))
    147 c          stop
    148142
    149143

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

    r764 r985  
    1212      USE parallel
    1313      USE times
     14      USE mod_hallo
    1415      IMPLICIT NONE
    1516c
    … …  
    3233      INTEGER  l,ij,iter,lh
    3334c    ...................................................................
    34 
     35      Type(Request) :: request_dissip
    3536      INTEGER ijb,ije
    3637c
    … …  
    4849c
    4950c$OMP BARRIER
    50 c$OMP MASTER
    51       call suspend_timer(timer_dissip)
    52       call exchange_Hallo(divgra,ip1jmp1,llm,1,1)
    53       call resume_timer(timer_dissip)
    54 c$OMP END MASTER
     51       call Register_Hallo(divgra,ip1jmp1,llm,1,1,1,1,Request_dissip)
     52       call SendRequest(Request_dissip)
    5553c$OMP BARRIER
     54       call WaitRequest(Request_dissip)
     55c$OMP BARRIER
     56
    5657      CALL laplacien_p( klevel, divgra, divgra )
    5758
    … …  
    7778      DO  iter = 1, lh - 2
    7879c$OMP BARRIER
    79 c$OMP MASTER
    80        call suspend_timer(timer_dissip)
    81        call exchange_Hallo(divgra,ip1jmp1,llm,1,1)
    82        call resume_timer(timer_dissip)
    83 c$OMP END MASTER
     80       call Register_Hallo(divgra,ip1jmp1,llm,1,1,1,1,Request_dissip)
     81       call SendRequest(Request_dissip)
    8482c$OMP BARRIER
     83       call WaitRequest(Request_dissip)
     84
     85c$OMP BARRIER
     86
     87
    8588       CALL laplacien_gam_p ( klevel,cuvscvgam2,cvuscugam2,unsair_gam2,
    8689     *                     unsapolnga2, unsapolsga2,  divgra, divgra )
    … …  
    98101c
    99102c$OMP BARRIER
    100 c$OMP MASTER
    101       call suspend_timer(timer_dissip)
    102       call exchange_Hallo(divgra,ip1jmp1,llm,1,1)
    103       call resume_timer(timer_dissip)
    104 c$OMP END MASTER
     103       call Register_Hallo(divgra,ip1jmp1,llm,1,1,1,1,Request_dissip)
     104       call SendRequest(Request_dissip)
     105c$OMP BARRIER
     106       call WaitRequest(Request_dissip)
    105107c$OMP BARRIER
    106108

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

    r764 r985  
    527527#include "advtrac.h"
    528528#include "temps.h"
     529#include "control.h"
    529530
    530531      INTEGER nq, l
    … …  
    536537     
    537538      REAL time
    538       INTEGER nid, nvarid
    539       INTEGER ierr
     539      INTEGER nid, nvarid, nid_trac, nvarid_trac
     540      REAL trac_tmp(ip1jmp1,llm)     
     541      INTEGER ierr, ierr_file
    540542      INTEGER iq
    541543      INTEGER length
    … …  
    641643#endif
    642644
     645      IF (config_inca /= 'none') THEN
     646! Ajout Anne pour lecture valeurs traceurs dans un fichier start_trac.nc
     647         ierr_file = NF_OPEN ("start_trac.nc", NF_NOWRITE,nid_trac)
     648         IF (ierr_file .NE.NF_NOERR) THEN
     649            write(6,*)' Pb d''ouverture du fichier start_trac.nc'
     650            write(6,*)' ierr = ', ierr_file
     651         ENDIF
     652      END IF
     653
    643654      IF(nq.GE.1) THEN
    644        do iq=1,nq   
    645         ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
    646         IF (ierr .NE. NF_NOERR) THEN
    647            PRINT*, "Variable  tname(iq) n est pas definie"
    648            CALL abort
    649         ENDIF
    650 #ifdef NC_DOUBLE
    651           ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q(1,1,iq))
    652 #else
    653           ierr = NF_PUT_VAR_REAL (nid,nvarid,q(1,1,iq))
    654 #endif
     655      do iq=1,nq
     656
     657         IF (config_inca == 'none') THEN
     658            ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
     659            IF (ierr .NE. NF_NOERR) THEN
     660               PRINT*, "Variable  tname(iq) n est pas definie"
     661               CALL abort
     662            ENDIF
     663#ifdef NC_DOUBLE
     664            ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q(1,1,iq))
     665#else
     666            ierr = NF_PUT_VAR_REAL (nid,nvarid,q(1,1,iq))
     667#endif
     668        ELSE ! config_inca = 'chem' ou 'aero'
     669! lecture de la valeur du traceur dans start_trac.nc
     670           IF (ierr_file .ne. 2) THEN
     671             ierr = NF_INQ_VARID (nid_trac, tname(iq), nvarid_trac)
     672             IF (ierr .NE. NF_NOERR) THEN
     673                PRINT*, tname(iq),"est absent de start_trac.nc"
     674                ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
     675                IF (ierr .NE. NF_NOERR) THEN
     676                   PRINT*, "Variable ", tname(iq)," n est pas definie"
     677                   CALL abort
     678                ENDIF
     679#ifdef NC_DOUBLE
     680                ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q(1,1,iq))
     681#else
     682                ierr = NF_PUT_VAR_REAL (nid,nvarid,q(1,1,iq))
     683#endif
     684               
     685             ELSE
     686                PRINT*, tname(iq), "est present dans start_trac.nc"
     687#ifdef NC_DOUBLE
     688               ierr = NF_GET_VAR_DOUBLE(nid_trac, nvarid_trac, trac_tmp)
     689#else
     690               ierr = NF_GET_VAR_REAL(nid_trac, nvarid_trac, trac_tmp)
     691#endif
     692                IF (ierr .NE. NF_NOERR) THEN
     693                   PRINT*, "Lecture echouee pour", tname(iq)
     694                   CALL abort
     695                ENDIF
     696                ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
     697                IF (ierr .NE. NF_NOERR) THEN
     698                   PRINT*, "Variable ", tname(iq)," n est pas definie"
     699                   CALL abort
     700                ENDIF
     701#ifdef NC_DOUBLE
     702                ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,trac_tmp)
     703#else
     704                ierr = NF_PUT_VAR_REAL (nid,nvarid,trac_tmp)
     705#endif
     706               
     707             ENDIF ! IF (ierr .NE. NF_NOERR)
     708! fin lecture du traceur
     709          ELSE                  ! si il n'y a pas de fichier start_trac.nc
     710!             print *, 'il n y a pas de fichier start_trac'
     711             ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
     712             IF (ierr .NE. NF_NOERR) THEN
     713                PRINT*, "Variable  tname(iq) n est pas definie"
     714                CALL abort
     715             ENDIF
     716#ifdef NC_DOUBLE
     717             ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q(1,1,iq))
     718#else
     719             ierr = NF_PUT_VAR_REAL (nid,nvarid,q(1,1,iq))
     720#endif
     721          ENDIF ! (ierr_file .ne. 2)
     722       END IF   ! config_inca
     723     
    655724      ENDDO
    656725      ENDIF
     726
     727
     728
     729
    657730c
    658731      ierr = NF_INQ_VARID(nid, "masse", nvarid)

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

    r774 r985  
    5151      INTEGER ije,ijb,jje,jjb
    5252c
    53 c$OMP MASTER           
     53c$OMP BARRIER           
    5454      unpl2k    = 1.+ 2.* kappa
    5555c
    … …  
    5757      ije=ij_end
    5858
    59 
     59c$OMP DO SCHEDULE(STATIC)
    6060      DO   ij  = ijb, ije
    6161        pks(ij) = cpp * ( ps(ij)/preff ) ** kappa
    6262      ENDDO
     63c$OMP ENDDO
     64c Synchro OPENMP ici
    6365
     66c$OMP MASTER
    6467      if (pole_nord) then
    6568        DO  ij   = 1, iim
    … …  
    8386        ENDDO
    8487      endif
    85 
     88c$OMP END MASTER
    8689c
    8790c
    8891c    .... Calcul des coeff. alpha et beta  pour la couche l = llm ..
    8992c
     93c$OMP DO SCHEDULE(STATIC)
    9094      DO     ij      = ijb,ije
    9195       alpha(ij,llm) = 0.
    9296       beta (ij,llm) = 1./ unpl2k
    9397      ENDDO
     98c$OMP ENDDO NOWAIT
    9499c
    95100c     ... Calcul des coeff. alpha et beta  pour l = llm-1  a l = 2 ...
    … …  
    97102      DO l = llm -1 , 2 , -1
    98103c
     104c$OMP DO SCHEDULE(STATIC)
    99105        DO ij = ijb, ije
    100106        dellta = p(ij,l)* unpl2k + p(ij,l+1)* ( beta(ij,l+1)-unpl2k )
    … …  
    102108        beta (ij,l)  =   p(ij,l  ) / dellta   
    103109        ENDDO
     110c$OMP ENDDO NOWAIT
    104111c
    105112      ENDDO
    … …  
    109116c     .....  Calcul de pk pour la couche 1 , pres du sol  ....
    110117c
    111 
     118c$OMP DO SCHEDULE(STATIC)
    112119      DO   ij   = ijb, ije
    113120       pk(ij,1) = ( p(ij,1)*pks(ij) - 0.5*alpha(ij,2)*p(ij,2) )  /
    114121     *    (  p(ij,1)* (1.+kappa) + 0.5*( beta(ij,2)-unpl2k )* p(ij,2) )
    115122      ENDDO
     123c$OMP ENDDO NOWAIT
    116124c
    117125c    ..... Calcul de pk(ij,l) , pour l = 2 a l = llm  ........
    118126c
    119127      DO l = 2, llm
     128c$OMP DO SCHEDULE(STATIC)
    120129        DO   ij   = ijb, ije
    121130         pk(ij,l) = alpha(ij,l) + beta(ij,l) * pk(ij,l-1)
    122131        ENDDO
     132c$OMP ENDDO NOWAIT       
    123133      ENDDO
    124134c
    125135c
    126136c      CALL SCOPY   ( ngrid * llm, pk, 1, pkf, 1 )
    127       pkf(ijb:ije,1:llm)=pk(ijb:ije,1:llm)
    128 c$OMP END MASTER
     137      DO l = 1, llm
     138c$OMP DO SCHEDULE(STATIC)
     139         DO   ij   = ijb, ije
     140           pkf(ij,l)=pk(ij,l)
     141         ENDDO
     142c$OMP ENDDO NOWAIT             
     143      ENDDO
     144
    129145c$OMP BARRIER
    130146     

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

    r763 r985  
     1
     2
    13      SUBROUTINE filtreg_p ( champ, ibeg, iend, nlat, nbniv,
    24     .                       ifiltre, iaire, griscal ,iter)
    35      USE Parallel, only : OMP_CHUNK
     6      USE mod_filtre_fft
     7      USE timer_filtre
    48      IMPLICIT NONE
    59
    … …  
    5963     ,             , matricevn(iim,iim,nfilvn),matricevs(iim,iim,nfilvs)
    6064     ,             ,  matrinvn(iim,iim,nfilun),matrinvs (iim,iim,nfilus)
    61       REAL  eignq(iim), sdd1(iim),sdd2(iim)
     65cym      REAL  eignq(iim), sdd1(iim),sdd2(iim)
     66
     67      REAL  eignq(iim)
     68      REAL :: sdd1(iim),sdd2(iim)
     69     
    6270      LOGICAL    griscal
    6371      INTEGER    hemisph, iaire
    64 c
     72     
     73      REAL :: champ_fft(iip1,nlat,nbniv)
     74      REAL :: champ_in(iip1,nlat,nbniv)
     75     
     76      REAL,SAVE,TARGET :: sddu_loc(iim)
     77      REAL,SAVE,TARGET :: sddv_loc(iim)
     78      REAL,SAVE,TARGET :: unsddu_loc(iim)
     79      REAL,SAVE,TARGET :: unsddv_loc(iim)
     80c$OMP THREADPRIVATE(sddu_loc,sddv_loc,unsddu_loc,unsddv_loc)
     81      LOGICAL,SAVE     :: first=.TRUE.
     82c$OMP THREADPRIVATE(first)
     83
     84      IF (first) THEN
     85        sddu_loc(1:iim)=sddu(1:iim)
     86        sddv_loc(1:iim)=sddv(1:iim)
     87        unsddu_loc(1:iim)=unsddu(1:iim)
     88        unsddv_loc(1:iim)=unsddv(1:iim)
     89        CALL Init_timer
     90        first=.FALSE.
     91c       PRINT *,"----> sddu_loc=",sddu_loc
     92c       PRINT *,"----> sddv_loc=",sddv_loc
     93c       PRINT *,"----> unsddu_loc=",unsddu_loc
     94c       PRINT *,"----> unsddv_loc=",unsddv_loc
     95      ENDIF
     96
     97c$OMP MASTER     
     98      CALL start_timer
     99c$OMP END MASTER
    65100
    66101      IF(ifiltre.EQ.1.or.ifiltre.EQ.-1)
    … …  
    97132c
    98133             IF( iaire.EQ.1 )  THEN
    99                 CALL SCOPY(  iim,    sddv, 1,  sdd1, 1 )
    100                 CALL SCOPY(  iim,  unsddv, 1,  sdd2, 1 )
     134cym                CALL SCOPY(  iim,    sddv, 1,  sdd1, 1 )
     135cym                CALL SCOPY(  iim,  unsddv, 1,  sdd2, 1 )
     136cym               sdd1=>sddv_loc
     137cym               sdd2=>unsddv_loc
     138               sdd1(1:iim)=sddv_loc(1:iim)
     139               sdd2(1:iim)=unsddv_loc(1:iim)
    101140             ELSE
    102                 CALL SCOPY(  iim,  unsddv, 1,  sdd1, 1 )
    103                 CALL SCOPY(  iim,    sddv, 1,  sdd2, 1 )
     141cym                CALL SCOPY(  iim,  unsddv, 1,  sdd1, 1 )
     142cym                CALL SCOPY(  iim,    sddv, 1,  sdd2, 1 )
     143               sdd1(1:iim)=unsddv_loc(1:iim)
     144               sdd2(1:iim)=sddv_loc(1:iim)
    104145             END IF
    105146c
    … …  
    116157c
    117158             IF( iaire.EQ.1 )  THEN
    118                 CALL SCOPY(  iim,    sddu, 1,  sdd1, 1 )
    119                 CALL SCOPY(  iim,  unsddu, 1,  sdd2, 1 )
     159cym                CALL SCOPY(  iim,    sddu, 1,  sdd1, 1 )
     160cym                CALL SCOPY(  iim,  unsddu, 1,  sdd2, 1 )
     161cym                sdd1=>sddu_loc
     162cym                sdd2=>unsddu_loc
     163                sdd1(1:iim)=sddu_loc(1:iim)
     164                sdd2(1:iim)=unsddu_loc(1:iim)
     165
    120166             ELSE
    121                 CALL SCOPY(  iim,  unsddu, 1,  sdd1, 1 )
    122                 CALL SCOPY(  iim,    sddu, 1,  sdd2, 1 )
     167cym                CALL SCOPY(  iim,  unsddu, 1,  sdd1, 1 )
     168cym                CALL SCOPY(  iim,    sddu, 1,  sdd2, 1 )
     169cym               sdd1=>unsddu_loc
     170cym               sdd2=>sddu_loc
     171               sdd1(1:iim)=unsddu_loc(1:iim)
     172               sdd2(1:iim)=sddu_loc(1:iim)
    123173             END IF
    124174c
    … …  
    129179          END IF
    130180      END IF
     181
     182c      PRINT *,"APPEL a filtreg --> sdd1=",sdd1
     183c      PRINT *,"APPEL a filtreg --> sdd2=",sdd2
     184c      PRINT *,"----> sddu_loc=",sddu_loc
     185c       PRINT *,"----> sddv_loc=",sddv_loc
     186c       PRINT *,"----> unsddu_loc=",unsddu_loc
     187c       PRINT *,"----> unsddv_loc=",unsddv_loc
     188 
    131189c
    132190c
    … …  
    143201      END IF
    144202
     203
     204cccccccccccccccccccccccccccccccccccccccccccc
     205c Utilisation du filtre classique
     206cccccccccccccccccccccccccccccccccccccccccccc
     207
     208      IF (.NOT. use_filtre_fft) THEN
     209     
    145210c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
    146211      DO 50  l = 1, nbniv
    147       DO 30  j = jdfil,jffil
     212        DO 30  j = jdfil,jffil
    148213 
    149214 
    150       DO  5  i = 1, iim
    151       champ(i,j,l) = champ(i,j,l) * sdd1(i)
    152    5  CONTINUE
    153 c
    154 
    155       IF( hemisph. EQ. 1 )      THEN
    156 
    157         IF( ifiltre. EQ. -2 )   THEN
    158 #ifdef CRAY
    159          CALL MXVA( matrinvn(1,1,j), 1, iim, champ(1,j,l), 1, eignq  ,
    160      *                             1, iim, iim                         )
    161 #else
    162 #ifdef BLAS
    163       CALL SGEMV("N", iim,iim, 1.0, matrinvn(1,1,j),iim,
    164      .           champ(1,j,l), 1, 0.0, eignq, 1)
    165 #else
    166       DO k = 1, iim
    167          eignq(k) = 0.0
    168       ENDDO
    169       DO k = 1, iim
    170       DO i = 1, iim
    171          eignq(k) = eignq(k) + matrinvn(k,i,j)*champ(i,j,l)
    172       ENDDO
    173       ENDDO
    174 #endif
    175 #endif
    176         ELSE IF ( griscal )     THEN
    177 #ifdef CRAY
    178          CALL MXVA( matriceun(1,1,j), 1, iim, champ(1,j,l), 1, eignq ,
    179      *                             1, iim, iim                         )
    180 #else
    181 #ifdef BLAS
    182       CALL SGEMV("N", iim,iim, 1.0, matriceun(1,1,j),iim,
    183      .           champ(1,j,l), 1, 0.0, eignq, 1)
    184 #else
    185       DO k = 1, iim
    186          eignq(k) = 0.0
    187       ENDDO
    188       DO i = 1, iim
    189       DO k = 1, iim
    190          eignq(k) = eignq(k) + matriceun(k,i,j)*champ(i,j,l)
    191       ENDDO
    192       ENDDO
    193 #endif
    194 #endif
    195         ELSE
    196 #ifdef CRAY
    197          CALL MXVA( matricevn(1,1,j), 1, iim, champ(1,j,l), 1, eignq ,
    198      *                             1, iim, iim                         )
    199 #else
    200 #ifdef BLAS
    201       CALL SGEMV("N", iim,iim, 1.0, matricevn(1,1,j),iim,
    202      .           champ(1,j,l), 1, 0.0, eignq, 1)
    203 #else
    204       DO k = 1, iim
    205          eignq(k) = 0.0
    206       ENDDO
    207       DO i = 1, iim
    208       DO k = 1, iim
    209          eignq(k) = eignq(k) + matricevn(k,i,j)*champ(i,j,l)
    210       ENDDO
    211       ENDDO
    212 #endif
    213 #endif
    214         ENDIF
    215 
    216       ELSE
    217 
    218         IF( ifiltre. EQ. -2 )   THEN
    219 #ifdef CRAY
    220          CALL MXVA( matrinvs(1,1,j-jfiltsu+1),  1, iim, champ(1,j,l),1 , 
    221      *                          eignq,  1, iim, iim                    )
    222 #else
    223 #ifdef BLAS
    224       CALL SGEMV("N", iim,iim, 1.0, matrinvs(1,1,j-jfiltsu+1),iim,
    225      .           champ(1,j,l), 1, 0.0, eignq, 1)
    226 #else
    227       DO k = 1, iim
    228          eignq(k) = 0.0
    229       ENDDO
    230       DO i = 1, iim
    231       DO k = 1, iim
    232          eignq(k) = eignq(k) + matrinvs(k,i,j-jfiltsu+1)*champ(i,j,l)
    233       ENDDO
    234       ENDDO
    235 #endif
    236 #endif
    237         ELSE IF ( griscal )     THEN
    238 #ifdef CRAY
    239          CALL MXVA( matriceus(1,1,j-jfiltsu+1), 1, iim, champ(1,j,l),1 ,
    240      *                          eignq,  1, iim, iim                    )
    241 #else
    242 #ifdef BLAS
    243       CALL SGEMV("N", iim,iim, 1.0, matriceus(1,1,j-jfiltsu+1),iim,
    244      .           champ(1,j,l), 1, 0.0, eignq, 1)
    245 #else
    246       DO k = 1, iim
    247          eignq(k) = 0.0
    248       ENDDO
    249       DO i = 1, iim
    250       DO k = 1, iim
    251          eignq(k) = eignq(k) + matriceus(k,i,j-jfiltsu+1)*champ(i,j,l)
    252       ENDDO
    253       ENDDO
    254 #endif
    255 #endif
    256         ELSE
    257 #ifdef CRAY
    258          CALL MXVA( matricevs(1,1,j-jfiltsv+1), 1, iim, champ(1,j,l),1 ,
    259      *                          eignq,  1, iim, iim                    )
    260 #else
    261 #ifdef BLAS
    262       CALL SGEMV("N", iim,iim, 1.0, matricevs(1,1,j-jfiltsv+1),iim,
    263      .           champ(1,j,l), 1, 0.0, eignq, 1)
    264 #else
    265       DO k = 1, iim
    266          eignq(k) = 0.0
    267       ENDDO
    268       DO i = 1, iim
    269       DO k = 1, iim
    270          eignq(k) = eignq(k) + matricevs(k,i,j-jfiltsv+1)*champ(i,j,l)
    271       ENDDO
    272       ENDDO
    273 #endif
    274 #endif
    275         ENDIF
    276 
    277       ENDIF
    278 c
    279       IF( ifiltre.EQ. 2 )  THEN
    280         DO 15 i = 1, iim
    281         champ( i,j,l ) = ( champ(i,j,l) + eignq(i) ) * sdd2(i)
    282   15    CONTINUE
    283       ELSE
    284         DO 16 i=1,iim
    285         champ( i,j,l ) = ( champ(i,j,l) - eignq(i) ) * sdd2(i)
    286 16      CONTINUE
    287       ENDIF
    288 c
    289       champ( iip1,j,l ) = champ( 1,j,l )
    290 c
    291   30  CONTINUE
     215          DO  5  i = 1, iim
     216            champ(i,j,l) = champ(i,j,l) * sdd1(i)
     217   5      CONTINUE
     218c
     219
     220          IF( hemisph. EQ. 1 )      THEN
     221
     222            IF( ifiltre. EQ. -2 )   THEN
     223
     224
     225              CALL SGEMV("N", iim,iim, 1.0, matrinvn(1,1,j),iim,
     226     .                     champ(1,j,l), 1, 0.0, eignq, 1)
     227
     228
     229            ELSE IF ( griscal )     THEN
     230
     231              CALL SGEMV("N", iim,iim, 1.0, matriceun(1,1,j),iim,
     232     .                    champ(1,j,l), 1, 0.0, eignq, 1)
     233
     234            ELSE
     235
     236              CALL SGEMV("N", iim,iim, 1.0, matricevn(1,1,j),iim,
     237     .                   champ(1,j,l), 1, 0.0, eignq, 1)
     238            ENDIF
     239
     240          ELSE
     241
     242            IF( ifiltre. EQ. -2 )   THEN
     243     
     244              CALL SGEMV("N",iim,iim,1.0, matrinvs(1,1,j-jfiltsu+1),iim,
     245     .                   champ(1,j,l), 1, 0.0, eignq, 1)
     246     
     247            ELSE IF ( griscal )     THEN
     248     
     249              CALL SGEMV("N",iim,iim,1.0,matriceus(1,1,j-jfiltsu+1),iim,
     250     .                   champ(1,j,l), 1, 0.0, eignq, 1)
     251            ELSE
     252         
     253              CALL SGEMV("N",iim,iim,1.0,matricevs(1,1,j-jfiltsv+1),iim,
     254     .                    champ(1,j,l), 1, 0.0, eignq, 1)
     255            ENDIF
     256
     257          ENDIF
     258
     259
     260c
     261          IF( ifiltre.EQ. 2 )  THEN
     262         
     263            DO 15 i = 1, iim
     264              champ( i,j,l ) = ( champ(i,j,l) + eignq(i) ) * sdd2(i)
     265  15        CONTINUE
     266         
     267          ELSE
     268       
     269            DO 16 i=1,iim
     270               champ( i,j,l ) = ( champ(i,j,l) - eignq(i) ) * sdd2(i)
     27116          CONTINUE
     272         
     273          ENDIF
     274c
     275          champ( iip1,j,l ) = champ( 1,j,l )
     276c
     277  30    CONTINUE
    292278c
    293279  50  CONTINUE
    294280c$OMP END DO NOWAIT
    295 c   
     281
     282ccccccccccccccccccccccccccccccccccccccccccccc
     283c Utilisation du filtre FFT
     284ccccccccccccccccccccccccccccccccccccccccccccc
     285       
     286       ELSE
     287       
     288c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     289          DO l=1,nbniv
     290            DO j=jdfil,jffil
     291              DO  i = 1, iim
     292                champ( i,j,l)= champ(i,j,l)*sdd1(i)
     293                champ_fft( i,j,l) = champ(i,j,l)
     294              ENDDO
     295            ENDDO
     296          ENDDO
     297c$OMP END DO NOWAIT
     298
     299      IF (jdfil<=jffil) THEN
     300        IF( ifiltre. EQ. -2 )   THEN
     301          CALL Filtre_inv_fft(champ_fft,nlat,jdfil,jffil,nbniv)
     302        ELSE IF ( griscal )     THEN
     303          CALL Filtre_u_fft(champ_fft,nlat,jdfil,jffil,nbniv)
     304        ELSE
     305          CALL Filtre_v_fft(champ_fft,nlat,jdfil,jffil,nbniv)
     306        ENDIF
     307      ENDIF
     308
     309
     310        IF( ifiltre.EQ. 2 )  THEN
     311c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)         
     312          DO l=1,nbniv
     313            DO j=jdfil,jffil
     314              DO  i = 1, iim
     315                champ( i,j,l)=(champ(i,j,l)+champ_fft(i,j,l))
     316     .                             *sdd2(i)
     317              ENDDO
     318            ENDDO
     319          ENDDO
     320c$OMP END DO NOWAIT       
     321        ELSE
     322       
     323c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 
     324          DO l=1,nbniv
     325            DO j=jdfil,jffil
     326              DO  i = 1, iim
     327                champ(i,j,l)=(champ(i,j,l)-champ_fft(i,j,l))
     328     .                            *sdd2(i)
     329              ENDDO
     330            ENDDO
     331          ENDDO
     332c$OMP END DO NOWAIT         
     333        ENDIF
     334c
     335c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     336        DO l=1,nbniv
     337          DO j=jdfil,jffil
     338!            champ_FFT( iip1,j,l ) = champ_FFT( 1,j,l )
     339            champ( iip1,j,l ) = champ( 1,j,l )
     340          ENDDO
     341        ENDDO
     342c$OMP END DO NOWAIT             
     343      ENDIF
     344c Fin de la zone de filtrage
     345
     346       
    296347 100  CONTINUE
     348
     349!      DO j=1,nlat
     350!     
     351!          PRINT *,"check FFT ----> Delta(",j,")=",
     352!     &            sum(champ(:,j,:)-champ_fft(:,j,:))/sum(champ(:,j,:)),
     353!     &            sum(champ(:,j,:)-champ_in(:,j,:))/sum(champ(:,j,:))
     354!      ENDDO
     355     
     356!          PRINT *,"check FFT ----> Delta(",j,")=",
     357!     &            sum(champ-champ_fft)/sum(champ)
     358!     
     359     
    297360c
    2983611111  FORMAT(//20x,'ERREUR dans le dimensionnement du tableau  CHAMP a
    … …  
    3003632222  FORMAT(//20x,'ERREUR dans le dimensionnement du tableau CHAMP a fi
    301364     *ltrer, sur la grille de V ou de Z'/)
     365c$OMP MASTER     
     366      CALL stop_timer
     367c$OMP END MASTER
    302368      RETURN
    303369      END

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

    r960 r985  
    1818      USE mod_hallo
    1919      USE Bands
    20       USE Write_Field
    21       USE Write_Field_phy
    2220      IMPLICIT NONE
    2321
    … …  
    225223      if (mpi_rank==0) call WriteBands
    226224      call SetDistrib(jj_Nb_Caldyn)
     225
     226c$OMP PARALLEL
    227227      call Init_Mod_hallo
     228c$OMP END PARALLEL
    228229
    229230c$OMP PARALLEL

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

    r790 r985  
    5050      ijb=ij_begin
    5151      ije=ij_end
    52       if (pole_nord) ijb=ij_begin+1
     52      if (pole_nord) ijb=ij_begin+iip1
    5353     
    5454      DO l=1,nx

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

    r774 r985  
    4949      ijb=ij_begin
    5050      ije=ij_end
    51       if (pole_nord) ijb=ij_begin+1
    52       if (pole_sud)  ije=ij_end-1
     51      if (pole_nord) ijb=ij_begin+iip1
     52      if (pole_sud)  ije=ij_end-iip1
    5353     
    5454      DO l=1,nx

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

    r764 r985  
    1616      USE times
    1717      USE Write_field_p
     18      USE mod_hallo
    1819      IMPLICIT NONE
    1920c
    … …  
    3334c
    3435      REAL,SAVE :: div(ip1jmp1,llm)
     36      REAL      :: tmp_div2(ip1jmp1,llm)
    3537      REAL signe, nugrads
    3638      INTEGER l,ij,iter,ld
    3739      INTEGER :: ijb,ije,jjb,jje
     40      Type(Request)  :: request_dissip
    3841     
    3942c    ........................................................
    … …  
    6366
    6467c$OMP BARRIER
    65 c$OMP MASTER     
    66       call suspend_timer(timer_dissip)
    67       call exchange_Hallo(gdy,ip1jm,llm,1,0)
    68       call resume_timer(timer_dissip)
    69 c$OMP END MASTER
     68       call Register_Hallo(gdy,ip1jm,llm,1,0,0,1,Request_dissip)
     69       call SendRequest(Request_dissip)
     70c$OMP BARRIER
     71       call WaitRequest(Request_dissip)
    7072c$OMP BARRIER
    7173c
    … …  
    8183      IF( ld.GT.1 )   THEN
    8284c$OMP BARRIER
    83 c$OMP MASTER       
    84         call suspend_timer(timer_dissip)
    85         call exchange_Hallo(div,ip1jmp1,llm,1,1)
    86         call resume_timer(timer_dissip)
    87 c$OMP END MASTER       
     85       call Register_Hallo(div,ip1jmp1,llm,1,1,1,1,Request_dissip)
     86       call SendRequest(Request_dissip)
     87c$OMP BARRIER
     88       call WaitRequest(Request_dissip)
    8889c$OMP BARRIER
    8990        CALL laplacien_p ( klevel, div,  div     )
    … …  
    9495        DO iter = 1, ld -2
    9596c$OMP BARRIER
    96 c$OMP MASTER
    97          call suspend_timer(timer_dissip)
    98          call exchange_Hallo(div,ip1jmp1,llm,1,1)
    99          call resume_timer(timer_dissip)
    100 c$OMP END MASTER
     97       call Register_Hallo(div,ip1jmp1,llm,1,1,1,1,Request_dissip)
     98       call SendRequest(Request_dissip)
    10199c$OMP BARRIER
     100       call WaitRequest(Request_dissip)
     101
     102c$OMP BARRIER
     103
    102104         CALL laplacien_gam ( klevel,cuvscvgam1,cvuscugam1,unsair_gam1,
    103105     *                       unsapolnga1, unsapolsga1,  div, div       )
    … …  
    112114c       call exchange_Hallo(div,ip1jmp1,llm,0,1)
    113115c$OMP BARRIER
    114 c$OMP MASTER       
    115         call suspend_timer(timer_dissip)
    116         call exchange_Hallo(div,ip1jmp1,llm,1,1)
    117         call resume_timer(timer_dissip)
    118 c$OMP END MASTER
     116       call Register_Hallo(div,ip1jmp1,llm,1,1,1,1,Request_dissip)
     117       call SendRequest(Request_dissip)
    119118c$OMP BARRIER
    120 c       call write_field3d_p('div4',reshape(div,(/iip1,jjp1,llm/)))
     119       call WaitRequest(Request_dissip)
     120
     121c$OMP BARRIER
     122
     123
    121124       CALL  grad_p  ( klevel,  div,   gdx,  gdy             )
    122125

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

    r865 r985  
    128128      jjn=jj_nb
    129129     
    130       print*,'OK0'
    131130      CALL pression_p( ip1jmp1, ap, bp, ps, p )
    132131      call massdair_p(p,masse)
    133       print*,'OK1'
    134132      CALL exner_hyb_p(ip1jmp1,ps,p,alpha,beta,pks,pk,pkf)
    135       print*,'OK2'
    136133      tnat(ijb:ije,:)=pk(ijb:ije,:)*teta(ijb:ije,:)/cpp
    137       print*,'OK3'
    138134      unskap   = 1./ kappa
    139135      pres(ijb:ije,:)=preff*(pk(ijb:ije,:)/cpp)**unskap
    140       print*,'OK4'
    141136      call q_sat(iip1*jjn*llm,tnat(ijb:ije,:),pres(ijb:ije,:),
    142137     .            qsat(ijb:ije,:))
    … …  
    151146c-----------------------------------------------------------------------
    152147
    153       print*,'ONLINE=',online
    154148      if(online.eq.-1) then
    155149          return

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

    r764 r985  
    5858      REAL tpn,tps,tppn(iim),tpps(iim)
    5959      REAL qpn,qps,qppn(iim),qpps(iim)
    60       REAL deltap( ip1jmp1,llm )
     60      REAL,SAVE :: deltap( ip1jmp1,llm )
    6161
    6262      INTEGER  l,ij,iq
    … …  
    6666      INTEGER ijb,ije,jjb,jje
    6767      REAL,SAVE :: ps(ip1jmp1)
     68      LOGICAL :: checksum
     69      INTEGER :: stop_it
    6870c-----------------------------------------------------------------------
    69      
     71c$OMP BARRIER     
    7072      if (pole_nord) THEN
    7173c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    … …  
    102104c$OMP END DO NOWAIT
    103105
    104 c$OMP MASTER     
     106c$OMP DO SCHEDULE(STATIC)
    105107      DO 2 ij = ijb,ije
    106108       pscr (ij)    = ps0(ij)
    107109       ps (ij)      = psm1(ij) + dt * dp(ij)
    108110   2  CONTINUE
    109 c
     111c$OMP END DO 
     112c$OMP BARRIER
     113c --> ici synchro OPENMP pour ps
     114       
     115      checksum=.TRUE.
     116      stop_it=0
     117
     118c$OMP DO SCHEDULE(STATIC)
    110119      DO ij = ijb,ije
    111         IF( ps(ij).LT.0. ) THEN
    112          PRINT*,' Au point ij = ',ij, ' , pression sol neg. ', ps(ij)
     120         IF( ps(ij).LT.0. ) THEN
     121           IF (checksum) stop_it=ij
     122           checksum=.FALSE.
     123         ENDIF
     124       ENDDO
     125c$OMP END DO NOWAIT
     126       
     127        IF( .NOT. checksum ) THEN
     128         PRINT*,' Au point ij = ',stop_it, ' , pression sol neg. '
     129     &         , ps(stop_it)
    113130         STOP' dans integrd'
    114131        ENDIF
    115       ENDDO
    116 c
     132
     133c
     134C$OMP MASTER
    117135      if (pole_nord) THEN
    118136     
    … …  
    248266      ije=ij_end
    249267     
    250 c$OMP MASTER
     268c$OMP BARRIER
     269c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    251270         DO l = 1, llm
    252271          DO ij = ijb, ije
    … …  
    254273          ENDDO
    255274         ENDDO
     275c$OMP END DO NOWAIT
     276c$OMP BARRIER
    256277
    257278         CALL qminimum_p( q, nq, deltap )
    … …  
    259280c    .....  Calcul de la valeur moyenne, unique  aux poles pour  q .....
    260281c
    261 
     282c$OMP BARRIER
    262283      IF (pole_nord) THEN
    263284     
    264285        DO iq = 1, nq
     286       
     287c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    265288          DO l = 1, llm
    266289 
    … …  
    275298 
    276299          ENDDO
     300c$OMP END DO NOWAIT
     301
    277302        ENDDO
    278303     
    … …  
    282307     
    283308        DO iq = 1, nq
     309
     310c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    284311          DO l = 1, llm
    285312 
    … …  
    294321 
    295322          ENDDO
    296         ENDDO
    297      
    298       ENDIF
    299      
    300 c$OMP END MASTER
    301 c$OMP BARRIER
    302 
     323c$OMP END DO NOWAIT
     324
     325        ENDDO
     326     
     327      ENDIF
     328     
    303329c         CALL  SCOPY( ijp1llm , finvmasse, 1, finvmaold, 1 )
    304330
    … …  
    31434015    continue
    315341
    316 c$OMP MASTER
    317         ps0(ijb:ije)=ps(ijb:ije)
    318 c$OMP END MASTER
     342c$OMP DO SCHEDULE(STATIC)
     343      DO ij=ijb,ije 
     344        ps0(ij)=ps(ij)
     345      ENDDO
     346c$OMP END DO NOWAIT
     347
    319348c    .................................................................
    320349
    … …  
    323352c       CALL SCOPY (    ip1jmp1 ,  pscr   , 1,   psm1  , 1 )
    324353c       CALL SCOPY ( ip1jmp1*llm, massescr, 1,  massem1, 1 )
    325 c$OMP MASTER
    326         psm1(ijb:ije)=pscr(ijb:ije)
    327 c$OMP END MASTER
     354c$OMP DO SCHEDULE(STATIC)
     355      DO ij=ijb,ije 
     356        psm1(ij)=pscr(ij)
     357      ENDDO
     358c$OMP END DO NOWAIT
    328359
    329360c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    … …  
    333364c$OMP END DO NOWAIT       
    334365      END IF
    335 
     366c$OMP BARRIER
    336367      RETURN
    337368      END

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

    r961 r985  
    66#define IO_DEBUG
    77
    8 !#undef CPP_IOIPSL
     8#undef CPP_IOIPSL
     9#define CPP_IOIPSL
    910
    1011      SUBROUTINE leapfrog_p(ucov,vcov,teta,ps,masse,phis,nq,q,clesphy0,
    … …  
    1920       USE Write_Field_p
    2021       USE vampir
     22       USE timer_filtre, ONLY : print_filtre_timer
    2123
    2224      IMPLICIT NONE
    … …  
    7173
    7274#include "academic.h"
    73 #include "clesphys.h"
     75!#include "clesphys.h"
    7476#include "advtrac.h"
    7577     
    … …  
    217219         ENDIF
    218220
    219 c$OMP MASTER
    220       OMP_CHUNK=5
    221 c$OMP END MASTER 
    222221c-----------------------------------------------------------------------
    223222c   On initialise la pression et la fonction d'Exner :
    … …  
    237236
    238237c$OMP MASTER
     238
     239!$OMP CRITICAL (MPI)
    239240      call MPI_BARRIER(COMM_LMDZ,ierr)
     241!$OMP END CRITICAL (MPI)
     242
    240243c$OMP END MASTER
    241244c$OMP BARRIER
    … …  
    297300
    298301         ENDDO
    299 c$OMP ENDDO         
     302c$OMP ENDDO 
    300303
    301304
    … …  
    321324c$OMP MASTER
    322325      ItCount=ItCount+1
    323       if (MOD(ItCount,1)==1) then
     326      if (MOD(ItCount,1)==0) then
    324327        debug=.true.
    325328      else
    … …  
    479482c$OMP MASTER
    480483       call VTb(VThallo)
     484c$OMP END MASTER
     485
    481486       call Register_Hallo(ucov,ip1jmp1,llm,1,1,1,1,TestRequest)
    482487       call Register_Hallo(vcov,ip1jm,llm,1,1,1,1,TestRequest)
    … …  
    494499
    495500       call SendRequest(TestRequest)
     501c$OMP BARRIER
    496502       call WaitRequest(TestRequest)
     503
     504c$OMP MASTER
    497505       call VTe(VThallo)
    498 
     506c$OMP END MASTER
     507c$OMP BARRIER
    499508     
    500509      if (debug) then       
     510!$OMP BARRIER
     511!$OMP MASTER
    501512        call WriteField_p('ucov',reshape(ucov,(/iip1,jmp1,llm/)))
    502513        call WriteField_p('vcov',reshape(vcov,(/iip1,jjm,llm/)))
    … …  
    511522          call WriteField_p('q'//trim(int2str(j)),
    512523     .                reshape(q(:,:,j),(/iip1,jmp1,llm/)))
    513         enddo       
     524        enddo
     525!$OMP END MASTER       
     526c$OMP BARRIER
    514527      endif
    515 c$OMP END MASTER
    516 c$OMP BARRIER
     528
    517529     
    518530      True_itau=True_itau+1
    519531
    520532c$OMP MASTER
    521 c     print*,"Iteration No",True_itau
     533      print*,"Iteration No",True_itau
    522534
    523535
    … …  
    529541      call VTb(VTcaldyn)
    530542c$OMP END MASTER
    531 c$OMP BARRIER
    532543      var_time=time+iday-day_ini
    533 cc$OMP PARALLEL DEFAULT(SHARED)
    534 cc$OMP+         PRIVATE(rdaym_ini,rdayvrai,ijb,ije,
    535 cc$OMP+                 tppn,tpn,tpps,tps)
    536 
    537 cc$OMP+         SHARED(itau,ucov,vcov,teta,ps,masse,pk,pkf,phis ,
    538 cc$OMP+                phi,conser,du,dv,dteta,dp,w, pbaru,pbarv,
    539 cc$OMP+                time, iday,day_ini,forward,leapf, iapptrac,
    540 cc$OMP+                q,dq,p,VTcaldyn,offline,dtvr,itau)     
    541 
     544
     545c$OMP BARRIER
     546!      CALL FTRACE_REGION_BEGIN("caldyn")
    542547      CALL caldyn_p
    543548     $  ( itau,ucov,vcov,teta,ps,masse,pk,pkf,phis ,
    544549     $    phi,conser,du,dv,dteta,dp,w, pbaru,pbarv, time+iday-day_ini )
    545550
    546 ccc$OMP END PARALLEL     
     551!      CALL FTRACE_REGION_END("caldyn")
    547552c$OMP MASTER
    548553      call VTe(VTcaldyn)
    549554c$OMP END MASTER     
     555
     556cc$OMP BARRIER
     557cc$OMP MASTER
    550558c      call WriteField_p('du',reshape(du,(/iip1,jmp1,llm/)))
    551559c      call WriteField_p('dv',reshape(dv,(/iip1,jjm,llm/)))
    … …  
    555563c      call WriteField_p('pbaru',reshape(pbaru,(/iip1,jmp1,llm/)))
    556564c      call WriteField_p('pbarv',reshape(pbarv,(/iip1,jjm,llm/)))
     565c      call WriteField_p('p',reshape(p,(/iip1,jmp1,llmp1/)))
     566c      call WriteField_p('masse',reshape(masse,(/iip1,jmp1,llm/)))
     567c      call WriteField_p('pk',reshape(pk,(/iip1,jmp1,llm/)))
     568cc$OMP END MASTER
    557569
    558570c-----------------------------------------------------------------------
    … …  
    566578     *        p, masse, dq,  teta,
    567579     .        flxw,pk, iapptrac)
    568          
    569 c      do j=1,nqmx
    570 c        call WriteField_p('q'//trim(int2str(j)),
    571 c     .                reshape(q(:,:,j),(/iip1,jmp1,llm/)))
    572 c        call WriteField_p('dq'//trim(int2str(j)),
    573 c     .                reshape(dq(:,:,j),(/iip1,jmp1,llm/)))
    574 c      enddo
     580
    575581       IF (offline) THEN
    576582Cmaf stokage du flux de masse pour traceurs OFF-LINE
    577 #undef CPP_IOIPSL
     583
    578584#ifdef CPP_IOIPSL
    579            CALL fluxstokenc(pbaru,pbarv,masse,teta,phi,phis,
     585           CALL fluxstokenc_p(pbaru,pbarv,masse,teta,phi,phis,
    580586     .   dtvr, itau)
    581587#endif
    … …  
    603609c      call WriteField_p('ps',reshape(ps,(/iip1,jmp1/)))
    604610cc$OMP PARALLEL DEFAULT(SHARED)
     611c$OMP BARRIER
     612!       CALL FTRACE_REGION_BEGIN("integrd")
    605613       CALL integrd_p ( 2,vcovm1,ucovm1,tetam1,psm1,massem1 ,
    606614     $         dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis ,
    607615     $              finvmaold                                    )
    608616
    609 
     617!       CALL FTRACE_REGION_END("integrd")
     618c$OMP BARRIER
     619cc$OMP MASTER
    610620c      call WriteField_p('ucovm1',reshape(ucovm1,(/iip1,jmp1,llm/)))
    611621c      call WriteField_p('vcovm1',reshape(vcovm1,(/iip1,jjm,llm/)))
    … …  
    616626c      call WriteField_p('teta',reshape(teta,(/iip1,jmp1,llm/)))
    617627c      call WriteField_p('dteta',reshape(dteta,(/iip1,jmp1,llm/)))
    618 
     628c
    619629c      call WriteField_p('ps',reshape(ps,(/iip1,jmp1/)))
     630c      do j=1,nqmx
     631c        call WriteField_p('q'//trim(int2str(j)),
     632c     .                reshape(q(:,:,j),(/iip1,jmp1,llm/)))
     633c        call WriteField_p('dq'//trim(int2str(j)),
     634c     .                reshape(dq(:,:,j),(/iip1,jmp1,llm/)))
     635c      enddo
     636cc$OMP END MASTER
     637
     638
    620639c$OMP MASTER
    621640       call VTe(VTintegre)
    … …  
    647666c$OMP MASTER
    648667         call suspend_timer(timer_caldyn)
    649 c        print*,'Entree dans la physique : Iteration No ',true_itau
    650 c$OMP END MASTER
    651 
    652 c$OMP BARRIER
     668         print*,'Entree dans la physique : Iteration No ',true_itau
     669c$OMP END MASTER
     670
    653671         CALL pression_p (  ip1jmp1, ap, bp, ps,  p      )
    654672
     673c$OMP BARRIER
     674
    655675         CALL exner_hyb_p(  ip1jmp1, ps, p,alpha,beta,pks, pk, pkf )
     676c$OMP BARRIER
    656677           rdaym_ini  = itau * dtvr / daysec
    657678           rdayvrai   = rdaym_ini  + day_ini
    … …  
    678699c$OMP MASTER
    679700        call VTb(VThallo)
     701c$OMP END MASTER
     702
    680703        call SetTag(Request_physic,800)
    681704       
    … …  
    716739       
    717740        call SendRequest(Request_Physic)
     741c$OMP BARRIER
    718742        call WaitRequest(Request_Physic)       
    719        
     743
     744c$OMP BARRIER
     745c$OMP MASTER
     746        call SetDistrib(jj_nb_Physic)
    720747        call VTe(VThallo)
    721748       
    … …  
    732759cc$OMP END MASTER
    733760cc$OMP BARRIER
    734        
     761!        CALL FTRACE_REGION_BEGIN("calfis")
    735762        CALL calfis_p( nq, lafin ,rdayvrai,time  ,
    736763     $               ucov,vcov,teta,q,masse,ps,p,pk,phis,phi ,
    … …  
    738765     $               flxw,
    739766     $               clesphy0, dufi,dvfi,dtetafi,dqfi,dpfi  )
     767!        CALL FTRACE_REGION_END("calfis")
    740768        ijb=ij_begin
    741769        ije=ij_end 
    … …  
    760788
    761789        call VTb(VThallo)
     790c$OMP END MASTER
     791c$OMP BARRIER
    762792 
    763793        call Register_Hallo(dufi,ip1jmp1,llm,
    … …  
    779809       
    780810        call SendRequest(Request_Physic)
     811c$OMP BARRIER
    781812        call WaitRequest(Request_Physic)
    782813             
     814c$OMP BARRIER
     815c$OMP MASTER
    783816        call VTe(VThallo)
    784817 
    … …  
    829862
    830863        call VTb(VThallo)
     864c$OMP END MASTER
    831865
    832866        call SetTag(Request_physic,800)
    … …  
    863897
    864898        call SendRequest(Request_Physic)
     899c$OMP BARRIER
    865900        call WaitRequest(Request_Physic)     
    866901
    867         call VTe(VThallo)
    868 
    869         call SetDistrib(jj_Nb_caldyn)
     902c$OMP BARRIER
     903c$OMP MASTER
     904       call VTe(VThallo)
     905       call SetDistrib(jj_Nb_caldyn)
    870906c$OMP END MASTER
    871907c$OMP BARRIER
    … …  
    916952       ENDIF
    917953
    918 c$OMP BARRIER
    919954        CALL pression_p ( ip1jmp1, ap, bp, ps, p                  )
     955c$OMP BARRIER
     956
     957
    920958        CALL exner_hyb_p( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
    921959c$OMP BARRIER
    … …  
    941979
    942980c$OMP BARRIER
    943 c$OMP MASTER
     981
    944982        call Register_SwapFieldHallo(ucov,ucov,ip1jmp1,llm,
    945983     *                          jj_Nb_dissip,1,1,Request_dissip)
    … …  
    958996
    959997        call SendRequest(Request_dissip)       
     998c$OMP BARRIER
    960999        call WaitRequest(Request_dissip)       
     1000
     1001c$OMP BARRIER
     1002c$OMP MASTER
    9611003        call SetDistrib(jj_Nb_dissip)
    962        
    9631004        call VTe(VThallo)
    964 
    9651005        call VTb(VTdissipation)
    966        
    9671006        call start_timer(timer_dissip)
    9681007c$OMP END MASTER
    … …  
    9741013c   dissipation
    9751014
     1015!        CALL FTRACE_REGION_BEGIN("dissip")
    9761016        CALL dissip_p(vcov,ucov,teta,p,dvdis,dudis,dtetadis)
     1017!        CALL FTRACE_REGION_END("dissip")
    9771018         
    9781019        ijb=ij_begin
    … …  
    10011042            call suspend_timer(timer_dissip)
    10021043            call VTb(VThallo)
    1003 
     1044c$OMP END MASTER
    10041045            call Register_Hallo(ucov,ip1jmp1,llm,1,1,1,1,Request_Dissip)
    10051046            call Register_Hallo(vcov,ip1jm,llm,1,1,1,1,Request_Dissip)
    10061047            call SendRequest(Request_Dissip)
     1048c$OMP BARRIER
    10071049            call WaitRequest(Request_Dissip)
     1050c$OMP MASTER
    10081051            call VTe(VThallo)
    10091052            call resume_timer(timer_dissip)
    … …  
    11041147       
    11051148        call VTb(VThallo)
    1106 
     1149c$OMP END MASTER
    11071150        call Register_SwapField(ucov,ucov,ip1jmp1,llm,
    11081151     *                          jj_Nb_caldyn,Request_dissip)
    … …  
    11211164
    11221165        call SendRequest(Request_dissip)       
     1166c$OMP BARRIER
    11231167        call WaitRequest(Request_dissip)       
     1168
     1169c$OMP BARRIER
     1170c$OMP MASTER
    11241171        call SetDistrib(jj_Nb_caldyn)
    11251172        call VTe(VThallo)
    … …  
    11271174c        print *,'fin dissipation'
    11281175c$OMP END MASTER
     1176c$OMP BARRIER
    11291177      END IF
    11301178
    … …  
    11931241      print *, 'Temps total ecoule sur la parallelisation :',DiffTime()
    11941242      print *, 'Temps CPU ecoule sur la parallelisation :',DiffCpuTime()
    1195 
     1243      CALL print_filtre_timer
    11961244        call finalize_parallel
    11971245c$OMP END MASTER
     1246c$OMP BARRIER
    11981247        RETURN
    11991248      ENDIF
    … …  
    12221271              abort_message = 'Simulation finished'
    12231272              call abort_gcm(modname,abort_message,0)
     1273              RETURN
    12241274            ENDIF
    12251275c-----------------------------------------------------------------------
    … …  
    12291279            IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN
    12301280c$OMP BARRIER
    1231 c$OMP MASTER
    12321281               IF(itau.EQ.itaufin) THEN
    12331282                  iav=1
    … …  
    12371286#ifdef CPP_IOIPSL
    12381287             call Register_Hallo(vcov,ip1jm,llm,1,0,0,1,TestRequest)
    1239               call SendRequest(TestRequest)
     1288             call SendRequest(TestRequest)
     1289c$OMP BARRIER
    12401290              call WaitRequest(TestRequest)
    1241 
     1291c$OMP MASTER
    12421292              CALL writedynav_p(histaveid, nqmx, itau,vcov ,
    12431293     ,                          ucov,teta,pk,phi,q,masse,ps,phis)
    1244 c               call bilan_dyn_p(2,dtvr*iperiod,dtvr*day_step*periodav,
    1245 c     ,           ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
     1294c$OMP END MASTER
     1295
    12461296#endif
    1247 c$OMP END MASTER
    12481297            ENDIF
    12491298
    … …  
    13761425                 abort_message = 'Simulation finished'
    13771426                 call abort_gcm(modname,abort_message,0)
     1427                 RETURN
    13781428               ENDIF
    13791429               GO TO 2
    … …  
    13891439#ifdef CPP_IOIPSL
    13901440c$OMP BARRIER
    1391 c$OMP MASTER
    13921441
    13931442              call Register_Hallo(vcov,ip1jm,llm,1,0,0,1,TestRequest)
    13941443              call SendRequest(TestRequest)
     1444c$OMP BARRIER
    13951445              call WaitRequest(TestRequest)
    13961446
     1447c$OMP MASTER
    13971448              CALL writedynav_p(histaveid, nqmx, itau,vcov ,
    13981449     ,                          ucov,teta,pk,phi,q,masse,ps,phis)
    1399 c               call bilan_dyn_p (2,dtvr*iperiod,dtvr*day_step*periodav,
    1400 c     ,           ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
     1450               call bilan_dyn_p (2,dtvr*iperiod,dtvr*day_step*periodav,
     1451     ,           ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
    14011452c$OMP END MASTER
    14021453#endif

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

    r884 r985  
    11MODULE mod_const_mpi
    22
    3   INTEGER :: COMM_LMDZ
    4   INTEGER :: MPI_REAL_LMDZ
     3  INTEGER,SAVE :: COMM_LMDZ
     4  INTEGER,SAVE :: MPI_REAL_LMDZ
    55 
    66
    … …  
    1414    INTEGER             :: ierr
    1515    INTEGER             :: comp_id
     16    INTEGER             :: thread_required
     17    INTEGER             :: thread_provided
    1618    CHARACTER(len = 6)  :: ocean
    1719
    … …  
    1921    ocean = 'force '
    2022    CALL getin('OCEAN', ocean)
    21 !$OMP END
     23!$OMP END MASTER
     24!$OMP BARRIER
    2225
    2326    IF (ocean=='couple') THEN
    2427#ifdef CPP_COUPLE
     28!$OMP MASTER
    2529       CALL prism_init_comp_proto (comp_id, 'lmdz.x', ierr)
    2630       CALL prism_get_localcomm_proto(COMM_LMDZ,ierr)
     31!$OMP END MASTER
    2732#endif
    2833    ELSE
    29        CALL MPI_INIT(ierr)
     34!$OMP MASTER
     35       thread_required=MPI_THREAD_SERIALIZED
     36       CALL MPI_INIT_THREAD(thread_required,thread_provided,ierr)
     37       IF (thread_provided < thread_required) THEN
     38         CALL abort_gcm('The multithreaded level of MPI librairy do not provide the requiered level', &
     39                        'mod_const_mpi::Init_const_mpi',1)
     40       ENDIF
    3041       COMM_LMDZ=MPI_COMM_WORLD
     42!$OMP END MASTER
    3143    END IF
    3244

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

    r807 r985  
    22USE parallel
    33implicit none
    4 
     4  logical,save :: use_mpi_alloc
    55  integer, parameter :: MaxRequest=200
    66  integer, parameter :: MaxProc=80
    … …  
    99 
    1010  integer,save       :: MaxBufferSize_Used
    11  
    12     real,save,pointer,dimension(:) :: Buffer
    13 
    14    integer,dimension(Listsize) :: Buffer_Pos
    15    integer :: Index_Pos
     11!$OMP THREADPRIVATE( MaxBufferSize_Used)
     12
     13   real,save,pointer,dimension(:) :: Buffer
     14!$OMP THREADPRIVATE(Buffer)
     15
     16   integer,save,dimension(Listsize) :: Buffer_Pos
     17   integer,save :: Index_Pos
     18!$OMP THREADPRIVATE(Buffer_Pos,Index_pos)
    1619   
    1720  type Hallo
    … …  
    4750    MaxBufferSize_Used=0
    4851
    49     CALL create_global_mpi_buffer
    50    
     52    IF (use_mpi_alloc) THEN
     53      CALL create_global_mpi_buffer
     54    ELSE
     55      CALL create_standard_mpi_buffer
     56    ENDIF
     57     
    5158  end subroutine init_mod_hallo
    52 
    5359
    5460  SUBROUTINE create_standard_mpi_buffer
    … …  
    5965  END SUBROUTINE create_standard_mpi_buffer
    6066 
    61 
    6267  SUBROUTINE create_global_mpi_buffer
    6368  IMPLICIT NONE
    … …  
    6873    INTEGER :: i,ierr
    6974
    70 
     75!  Allocation du buffer MPI
    7176      Bs=8*MaxBufferSize
     77!$OMP CRITICAL (MPI)
    7278      CALL MPI_ALLOC_MEM(BS,MPI_INFO_NULL,Pbuffer,ierr)
     79!$OMP END CRITICAL (MPI)
    7380      DO i=1,MaxBufferSize
    7481        MPI_Buffer(i)=i
    … …  
    8895                                     
    8996  END SUBROUTINE create_global_mpi_buffer
    90 
    91 
     97 
    9298     
    9399  subroutine allocate_buffer(Size,Index,Pos)
    … …  
    381387      integer :: i,rank,l,ij,Pos,ierr
    382388      integer :: offset
    383 !      real,dimension(:),pointer :: Buffer
    384389      real,dimension(:,:),pointer :: Field
    385390      integer :: Nb
    … …  
    392397        do i=1,Req%NbRequest
    393398          PtrHallo=>Req%Hallo(i)
    394           SizeBuffer=SizeBuffer+PtrHallo%size*PtrHallo%NbLevel*iip1
     399!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     400          DO l=1,PtrHallo%NbLevel
     401            SizeBuffer=SizeBuffer+PtrHallo%size*iip1
     402          ENDDO
     403!$OMP ENDDO NOWAIT         
    395404        enddo
    396405     
    397406        if (SizeBuffer>0) then
    398407       
    399 !          allocate(Req%Buffer(SizeBuffer))
    400408          call allocate_buffer(SizeBuffer,Req%Index,Req%pos)
    401409
    402410          Pos=Req%Pos
    403 !          Buffer=>req%Buffer
    404411          do i=1,Req%NbRequest
    405412            PtrHallo=>Req%Hallo(i)
    … …  
    407414            Nb=iip1*PtrHallo%size-1
    408415            Field=>PtrHallo%Field
    409            
     416
     417!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)           
    410418            do l=1,PtrHallo%NbLevel
    411419!cdir NODEP
    … …  
    413421                Buffer(Pos+ij)=Field(Offset+ij,l)
    414422              enddo
    415 !              Buffer(Pos:Pos+Nb)=Field(offset:offset+Nb,l)
    416423             
    417424              Pos=Pos+Nb+1
    418425            enddo
    419            
     426!$OMP END DO NOWAIT           
    420427          enddo
    421428   
    422 !         print *, 'process',MPI_RANK,'ISSEND: requette ',a_request%tag,'au process',rank,'de taille',SizeBuffer
    423 !         call MPI_ISSEND(Req%Buffer,SizeBuffer,MPI_REAL8,rank,a_request%tag,     &
    424 !                         COMM_LMDZ,Req%MSG_Request,ierr)
    425          call MPI_ISSEND(Buffer(req%Pos),SizeBuffer,MPI_REAL8,rank,a_request%tag,     &
     429!$OMP CRITICAL (MPI)
     430         call MPI_ISSEND(Buffer(req%Pos),SizeBuffer,MPI_REAL8,rank,a_request%tag+1000*omp_rank,     &
    426431                         COMM_LMDZ,Req%MSG_Request,ierr)
    427 
     432!         PRINT *,"-------------------------------------------------------------------"
     433!         PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->"
     434!         PRINT *,"Requete envoye au proc :",rank,"tag :",a_request%tag+1000*omp_rank
     435!         PRINT *,"Taille du message :",SizeBuffer,"requete no :",Req%MSG_Request
     436!         PRINT *,"-------------------------------------------------------------------"
     437!$OMP END CRITICAL (MPI)
    428438        endif
    429439
    … …  
    438448          do i=1,Req%NbRequest
    439449            PtrHallo=>Req%Hallo(i)
    440             SizeBuffer=SizeBuffer+PtrHallo%size*PtrHallo%NbLevel*iip1
     450
     451!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     452            DO l=1,PtrHallo%NbLevel
     453              SizeBuffer=SizeBuffer+PtrHallo%size*iip1
     454            ENDDO
     455!$OMP ENDDO NOWAIT         
    441456          enddo
    442457       
    443458          if (SizeBuffer>0) then
    444 !            allocate(Req%Buffer(SizeBuffer))
     459
    445460             call allocate_buffer(SizeBuffer,Req%Index,Req%Pos)
    446 !            print *, 'process',MPI_RANK,'IRECV: requette ',a_request%tag,'au process',rank,'de taille',SizeBuffer
    447            
    448 !           call MPI_IRECV(Req%Buffer,SizeBuffer,MPI_REAL8,rank,a_request%tag,     &
    449 !                           COMM_LMDZ,Req%MSG_Request,ierr)
    450             call MPI_IRECV(Buffer(Req%Pos),SizeBuffer,MPI_REAL8,rank,a_request%tag,     &
     461!$OMP CRITICAL (MPI)
     462             call MPI_IRECV(Buffer(Req%Pos),SizeBuffer,MPI_REAL8,rank,a_request%tag+1000*omp_rank,     &
    451463                           COMM_LMDZ,Req%MSG_Request,ierr)
    452 
     464!         PRINT *,"-------------------------------------------------------------------"
     465!         PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->"
     466!         PRINT *,"Requete en attente du proc :",rank,"tag :",a_request%tag+1000*omp_rank
     467!         PRINT *,"Taille du message :",SizeBuffer,"requete no :",Req%MSG_Request
     468!         PRINT *,"-------------------------------------------------------------------"
     469
     470!$OMP END CRITICAL (MPI)
    453471          endif
    454472     
    … …  
    492510      enddo
    493511     
    494       if (NbRequest>0) call MPI_WAITALL(NbRequest,TabRequest,TabStatus,ierr)
    495      
     512      if (NbRequest>0) then
     513!$OMP CRITICAL (MPI)
     514!        PRINT *,"-------------------------------------------------------------------"
     515!        PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"en attente"
     516!        PRINT *,"No des requetes :",TabRequest(1:NbRequest)
     517        call MPI_WAITALL(NbRequest,TabRequest,TabStatus,ierr)
     518!        PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"complete"
     519!        PRINT *,"-------------------------------------------------------------------"
     520!$OMP END CRITICAL (MPI)
     521      endif
    496522      do rank=0,MPI_Size-1
    497523        Req=>a_request%RequestRecv(rank)
    … …  
    502528            offset=(PtrHallo%offset-1)*iip1+1
    503529            Nb=iip1*PtrHallo%size-1
    504            
     530
     531!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)           
    505532            do l=1,PtrHallo%NbLevel
    506533!cdir NODEP
    … …  
    508535                PtrHallo%Field(offset+ij,l)=Buffer(Pos+ij)
    509536              enddo
    510 !              PtrHallo%Field(offset:offset+Nb,l)=Buffer(Pos:Pos+Nb)
    511 !             do ij=offset,offset+iip1*PtrHallo%size-1
    512 !                PtrHallo%Field(ij,l)=Buffer(Pos)
    513 !                Pos=Pos+1
    514 !              enddo
     537
    515538              Pos=Pos+Nb+1
    516539            enddo
    517            
     540!$OMP ENDDO NOWAIT         
    518541          enddo
    519542        endif
    … …  
    566589     
    567590
    568       if (NbRequest>0) call MPI_WAITALL(NbRequest,TabRequest,TabStatus,ierr)
    569      
     591      if (NbRequest>0) THEN
     592!$OMP CRITICAL (MPI)     
     593!        PRINT *,"-------------------------------------------------------------------"
     594!        PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"en attente"
     595!        PRINT *,"No des requetes :",TabRequest(1:NbRequest)
     596        call MPI_WAITALL(NbRequest,TabRequest,TabStatus,ierr)
     597!        PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"complete"
     598!        PRINT *,"-------------------------------------------------------------------"
     599
     600!$OMP END CRITICAL (MPI)
     601      endif     
    570602     
    571603      do rank=0,MPI_SIZE-1
    … …  
    608640     
    609641     
    610       if (NbRequest>0) call MPI_WAITALL(NbRequest,TabRequest,TabStatus,ierr)
     642      if (NbRequest>0) then
     643!$OMP CRITICAL (MPI)     
     644!        PRINT *,"-------------------------------------------------------------------"
     645!        PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"en attente"
     646!        PRINT *,"No des requetes :",TabRequest(1:NbRequest)
     647        call MPI_WAITALL(NbRequest,TabRequest,TabStatus,ierr)
     648!        PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"complete"
     649!        PRINT *,"-------------------------------------------------------------------"
     650!$OMP END CRITICAL (MPI)     
     651      endif
    611652     
    612653      do rank=0,MPI_Size-1
    … …  
    618659            offset=(PtrHallo%offset-1)*iip1+1
    619660            Nb=iip1*PtrHallo%size-1
    620            
     661!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)           
    621662            do l=1,PtrHallo%NbLevel
    622663!cdir NODEP
    … …  
    626667                 Pos=Pos+Nb+1
    627668            enddo
     669!$OMP END DO NOWAIT
    628670          enddo
    629671        endif
    … …  
    651693    include 'mpif.h'
    652694   
    653     INTEGER :: ij,ll
     695    INTEGER :: ij,ll,l
    654696    REAL, dimension(ij,ll) :: FieldS
    655697    REAL, dimension(ij,ll) :: FieldR
    … …  
    673715      ijb=(jjb-1)*iip1+1
    674716      ije=jje*iip1
    675       FieldR(ijb:ije,1:ll)=FieldS(ijb:ije,1:ll)
     717
     718!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     719      do l=1,ll
     720        FieldR(ijb:ije,l)=FieldS(ijb:ije,l)
     721      enddo
     722!$OMP ENDDO NOWAIT
    676723    endif
     724
    677725
    678726  end subroutine CopyField   
    … …  
    691739    integer,dimension(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
    692740
    693     integer ::i,jje,jjb,ijb,ije
     741    integer ::i,jje,jjb,ijb,ije,l
    694742
    695743     
    … …  
    710758      ijb=(jjb-1)*iip1+1
    711759      ije=jje*iip1
    712       FieldR(ijb:ije,1:ll)=FieldS(ijb:ije,1:ll)
     760
     761!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     762      do l=1,ll
     763        FieldR(ijb:ije,l)=FieldS(ijb:ije,l)
     764      enddo
     765!$OMP ENDDO NOWAIT
     766
    713767    endif
    714768   end subroutine CopyFieldHallo       

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

    r764 r985  
    1515      USE parallel
    1616      USE times
     17      USE mod_hallo
    1718      IMPLICIT NONE
    1819c
    … …  
    3334      REAL  signe, nugradrs
    3435      INTEGER l,ij,iter,lr
     36      Type(Request) :: Request_dissip
    3537c    ........................................................
    3638c
    … …  
    5557
    5658c$OMP BARRIER
    57 c$OMP MASTER         
    58       call suspend_timer(timer_dissip)
    59       call exchange_Hallo(grx,ip1jmp1,llm,0,1)
    60       call resume_timer(timer_dissip)
    61 c$OMP END MASTER
     59       call Register_Hallo(grx,ip1jmp1,llm,0,1,1,0,Request_dissip)
     60       call SendRequest(Request_dissip)
     61c$OMP BARRIER
     62       call WaitRequest(Request_dissip)
    6263c$OMP BARRIER
    6364
    … …  
    7778
    7879c$OMP BARRIER
    79 c$OMP MASTER     
    80       call suspend_timer(timer_dissip)
    81       call exchange_Hallo(rot,ip1jm,llm,1,1)
    82       call resume_timer(timer_dissip)
    83 c$OMP END MASTER
     80       call Register_Hallo(rot,ip1jm,llm,1,1,1,1,Request_dissip)
     81       call SendRequest(Request_dissip)
     82c$OMP BARRIER
     83       call WaitRequest(Request_dissip)
    8484c$OMP BARRIER
    8585     
    … …  
    9191      DO  iter = 1, lr -2
    9292c$OMP BARRIER
    93 c$OMP MASTER
    94         call suspend_timer(timer_dissip)
    95         call exchange_Hallo(rot,ip1jm,llm,1,1)
    96         call resume_timer(timer_dissip)
    97 c$OMP END MASTER
     93       call Register_Hallo(rot,ip1jm,llm,1,1,1,1,Request_dissip)
     94       call SendRequest(Request_dissip)
    9895c$OMP BARRIER
     96       call WaitRequest(Request_dissip)
     97c$OMP BARRIER
     98
    9999        CALL laplacien_rotgam_p ( klevel, rot, rot )
    100100      ENDDO
    … …  
    110110      CALL filtreg_p( rot, jjb,jje,jjm, klevel, 2,1, .FALSE.,1)
    111111c$OMP BARRIER
    112 c$OMP MASTER
    113       call suspend_timer(timer_dissip)
    114       call exchange_Hallo(rot,ip1jm,llm,1,0)
    115       call resume_timer(timer_dissip)
    116 c$OMP END MASTER
     112       call Register_Hallo(rot,ip1jm,llm,1,0,0,1,Request_dissip)
     113       call SendRequest(Request_dissip)
    117114c$OMP BARRIER
     115       call WaitRequest(Request_dissip)
     116c$OMP BARRIER
     117
    118118      CALL nxgrad_p ( klevel, rot, grx, gry )
    119119

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

    r884 r985  
    1616    integer, allocatable, save, dimension(:) :: jj_nb_para
    1717    integer, save :: OMP_CHUNK
    18    
     18    integer, save :: omp_rank
     19    integer, save :: omp_size 
     20!$OMP THREADPRIVATE(omp_rank)
     21
    1922 contains
    2023 
    … …  
    2730      integer :: type_size
    2831      integer, dimension(3) :: blocklen,type
    29      
    30      
     32      integer :: comp_id
     33#ifdef _OPENMP   
     34      INTEGER :: OMP_GET_NUM_THREADS
     35      EXTERNAL OMP_GET_NUM_THREADS
     36      INTEGER :: OMP_GET_THREAD_NUM
     37      EXTERNAL OMP_GET_THREAD_NUM
     38#endif 
    3139      include 'mpif.h'
    3240#include "dimensions.h"
    … …  
    95103      print *,"ij_begin",ij_begin
    96104      print *,"ij_end",ij_end
    97    
     105
     106!$OMP PARALLEL
     107
     108#ifdef _OPENMP
     109!$OMP MASTER
     110        omp_size=OMP_GET_NUM_THREADS()
     111!$OMP END MASTER
     112        omp_rank=OMP_GET_THREAD_NUM()   
     113#else   
     114        omp_size=1
     115        omp_rank=0
     116#endif
     117!$OMP END PARALLEL         
    98118   
    99119    end subroutine init_parallel
    … …  
    230250      REAL, dimension(:),allocatable :: Buffer_Recv_up,Buffer_Recv_down
    231251      INTEGER :: Buffer_size     
    232      
     252
     253!$OMP CRITICAL (MPI)     
    233254      call MPI_Barrier(COMM_LMDZ,ierr)
     255!$OMP END CRITICAL (MPI)
    234256      call VTb(VThallo)
    235257     
    … …  
    266288        allocate(Buffer_Send_up(Buffer_size))
    267289        call PACK_Data(Field(ij_begin,1),ij,ll,down,Buffer_Send_up)
     290!$OMP CRITICAL (MPI)
    268291        call MPI_ISSEND(Buffer_send_up,Buffer_Size,MPI_REAL8,MPI_Rank-1,1,     &
    269292                        COMM_LMDZ,Request(NbRequest),ierr)
     293!$OMP END CRITICAL (MPI)
    270294      ENDIF
    271295 
    … …  
    277301        call PACK_Data(Field(ij_end+1-up*iip1,1),ij,ll,up,Buffer_send_down)
    278302       
     303!$OMP CRITICAL (MPI)
    279304        call MPI_ISSEND(Buffer_send_down,Buffer_Size,MPI_REAL8,MPI_Rank+1,1,     &
    280305                        COMM_LMDZ,Request(NbRequest),ierr)
     306!$OMP END CRITICAL (MPI)
    281307      ENDIF
    282308   
    … …  
    287313        allocate(Buffer_recv_up(Buffer_size))
    288314             
     315!$OMP CRITICAL (MPI)
    289316        call MPI_IRECV(Buffer_recv_up,Buffer_size,MPI_REAL8,MPI_Rank-1,1,  &
    290317                        COMM_LMDZ,Request(NbRequest),ierr)
     318!$OMP END CRITICAL (MPI)
    291319     
    292320       
    … …  
    298326        allocate(Buffer_recv_down(Buffer_size))
    299327       
     328!$OMP CRITICAL (MPI)
    300329        call MPI_IRECV(Buffer_recv_down,Buffer_size,MPI_REAL8,MPI_Rank+1,1,     &
    301330                        COMM_LMDZ,Request(NbRequest),ierr)
     331!$OMP END CRITICAL (MPI)
    302332     
    303333       
    … …  
    309339
    310340      call VTe(VThallo)
     341!$OMP CRITICAL (MPI)
    311342      call MPI_Barrier(COMM_LMDZ,ierr)
     343!$OMP END CRITICAL (MPI)
     344
    312345      RETURN
    313346     
    314347    end subroutine exchange_Hallo
    315348   
    316    
     349
    317350    subroutine Gather_Field(Field,ij,ll,rank)
    318351    implicit none
    … …  
    342375      if (MPI_Rank==rank) then
    343376        allocate(Buffer_Recv(ij*ll))
     377
     378!CDIR NOVECTOR
    344379        do i=0,MPI_Size-1
    345          
     380           
    346381          if (ij==ip1jmp1) then
    347382            Recv_count(i)=(jj_end_para(i)-jj_begin_para(i)+1)*ll*iip1
    … …  
    351386            stop 'erreur dans Gather_Field'
    352387          endif
    353          
     388                 
    354389          if (i==0) then
    355390            displ(i)=0
    … …  
    361396       
    362397      endif
    363      
     398 
     399!$OMP CRITICAL (MPI)
    364400      call MPI_GATHERV(Buffer_send,(min(ij_end,ij)-ij_begin+1)*ll,MPI_REAL8,   &
    365401                        Buffer_Recv,Recv_count,displ,MPI_REAL8,rank,COMM_LMDZ,ierr)
     402!$OMP END CRITICAL (MPI)
    366403     
    367404      if (MPI_Rank==rank) then                 
    … …  
    380417     
    381418      endif
    382       
     419     
    383420    end subroutine Gather_Field
    384    
     421
     422
    385423    subroutine AllGather_Field(Field,ij,ll)
    386424    implicit none
    … …  
    394432     
    395433      call Gather_Field(Field,ij,ll,0)
     434!$OMP CRITICAL (MPI)
    396435      call MPI_BCAST(Field,ij*ll,MPI_REAL8,0,COMM_LMDZ,ierr)
     436!$OMP END CRITICAL (MPI)
    397437     
    398438    end subroutine AllGather_Field
    … …  
    409449      INTEGER :: ierr
    410450     
     451!$OMP CRITICAL (MPI)
    411452      call MPI_BCAST(Field,ij*ll,MPI_REAL8,rank,COMM_LMDZ,ierr)
     453!$OMP END CRITICAL (MPI)
    412454     
    413455    end subroutine Broadcast_Field

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

    r630 r985  
    3434      SAVE imprim
    3535      DATA imprim /0/
     36c$OMP THREADPRIVATE(imprim)
    3637      INTEGER ijb,ije
     38      INTEGER Index_pump(ip1jmp1)
     39      INTEGER nb_pump
    3740c
    3841c Quand l'eau liquide est trop petite (ou negative), on prend
    … …  
    4043c (sans changer la temperature !)
    4144c
     45
    4246      ijb=ij_begin
    4347      ije=ij_end
    44      
     48
     49c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
    4550      DO 1000 k = 1, llm
    4651      DO 1040 i = ijb, ije
    … …  
    5055 1040 CONTINUE
    5156 1000 CONTINUE
     57c$OMP END DO NOWAIT
     58c$OMP BARRIER
     59c --->  SYNCHRO OPENMP ICI
     60
    5261c
    5362c Quand l'eau vapeur est trop faible (ou negative), on complete
    … …  
    5867      DO k = llm, 2, -1
    5968ccc      zx_abc = dpres(k) / dpres(k-1)
     69c$OMP DO SCHEDULE(STATIC)
    6070      DO i = ijb, ije
    6171         zx_abc = deltap(i,k)/deltap(i,k-1)
    … …  
    6474         q(i,k,iq)   =  q(i,k,iq)   + zx_defau 
    6575      ENDDO
     76c$OMP END DO NOWAIT
    6677      ENDDO
     78c$OMP BARRIER
    6779c
    6880c Quand il s'agit de la premiere couche au-dessus du sol, on
    6981c doit imprimer un message d'avertissement (saturation possible).
    7082c
     83      nb_pump=0
     84c$OMP DO SCHEDULE(STATIC)
    7185      DO i = ijb, ije
    7286         zx_pump(i) = AMAX1( 0.0, seuil_vap - q(i,1,iq) )
    7387         q(i,1,iq)  = AMAX1( q(i,1,iq), seuil_vap )
     88         IF (zx_pump(i) > 0.0) THEN
     89            nb_pump = nb_pump+1
     90            Index_pump(nb_pump)=i
     91         ENDIF
    7492      ENDDO
    75       pompe = SSUM(ije-ijb+1,zx_pump(ijb),1)
    76       IF (imprim.LE.500 .AND. pompe.GT.0.0) THEN
    77          WRITE(6,'(1x,"ATT!:on pompe de l eau au sol",e15.7)') pompe
    78          DO i = ijb, ije
    79             IF (zx_pump(i).GT.0.0) THEN
     93c$OMP END DO 
     94!      pompe = SSUM(ije-ijb+1,zx_pump(ijb),1)
     95
     96      IF (imprim.LE.100 .AND. nb_pump .GT. 0 ) THEN
     97         PRINT *, 'ATT!:on pompe de l eau au sol'
     98         DO i = 1, nb_pump
    8099               imprim = imprim + 1
    81                PRINT*,'  en ',i,zx_pump(i)
    82             ENDIF
     100               PRINT*,'  en ',index_pump(i),zx_pump(index_pump(i))
    83101         ENDDO
    84102      ENDIF

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

    r796 r985  
    1818      INTEGER*4 day_ini, day_end, annee_ref, day_ref
    1919      REAL      dt
    20 
    21 !-----------------------------------------------------------------------
     20!$OMP THREADPRIVATE(/temps/)

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

    r854 r985  
    8787c-- approximation: au milieu des couches play(l)=(p(l)+p(l+1))/2
    8888c   pour eviter une exponentielle.
    89 c$OMP MASTER
     89
    9090      call SetTag(MyRequest1,100)
    9191      call SetTag(MyRequest2,101)
    92 c$OMP END MASTER
     92
    9393       
    9494        ijb=ij_begin-iip1
    … …  
    182182       
    183183        else if (iadv(iq)==10) then
    184        
     184
     185#ifdef _ADV_HALO       
     186          call vlx_p(zq(1,1,iq),pente_max,zm(1,1,iq),mu,
     187     &               ij_begin,ij_begin+2*iip1-1)
     188          call vlx_p(zq(1,1,iq),pente_max,zm(1,1,iq),mu,
     189     &               ij_end-2*iip1+1,ij_end)
     190#else
    185191          call vlx_p(zq(1,1,iq),pente_max,zm(1,1,iq),mu,
    186192     &               ij_begin,ij_end)
     193#endif
    187194
    188195c$OMP MASTER
    189196          call VTb(VTHallo)
     197c$OMP END MASTER
    190198          call Register_Hallo(zq(1,1,iq),ip1jmp1,llm,2,2,2,2,MyRequest1)
    191199          call Register_Hallo(zm(1,1,iq),ip1jmp1,llm,1,1,1,1,MyRequest1)
     200
     201c$OMP MASTER
    192202          call VTe(VTHallo)
    193203c$OMP END MASTER
    194204        else if (iadv(iq)==14) then
    195      
     205
     206#ifdef _ADV_HALO           
     207          call vlxqs_p(zq(1,1,iq),pente_max,zm(1,1,iq),mu,qsat,
     208     &                 ij_begin,ij_begin+2*iip1-1)
     209          call vlxqs_p(zq(1,1,iq),pente_max,zm(1,1,iq),mu,qsat,
     210     &                 ij_end-2*iip1+1,ij_end)
     211#else
     212
    196213          call vlxqs_p(zq(1,1,iq),pente_max,zm(1,1,iq),mu,qsat,
    197214     &                 ij_begin,ij_end)
     215#endif
     216
    198217c$OMP MASTER
    199218          call VTb(VTHallo)
     219c$OMP END MASTER
     220
    200221          call Register_Hallo(zq(1,1,iq),ip1jmp1,llm,2,2,2,2,MyRequest1)
    201222          call Register_Hallo(zm(1,1,iq),ip1jmp1,llm,1,1,1,1,MyRequest1)
     223
     224c$OMP MASTER
    202225          call VTe(VTHallo)
    203226c$OMP END MASTER
    … …  
    214237c$OMP MASTER     
    215238      call VTb(VTHallo)
     239c$OMP END MASTER
     240
    216241      call SendRequest(MyRequest1)
    217       call WaitRecvRequest(MyRequest1)
    218       call WaitSendRequest(MyRequest1)
     242
     243c$OMP MASTER
     244      call VTe(VTHallo)
     245c$OMP END MASTER       
     246c$OMP BARRIER
     247      do iq=1,nqmx
     248
     249        if(iadv(iq) == 0) then
     250       
     251          cycle
     252       
     253        else if (iadv(iq)==10) then
     254
     255#ifdef _ADV_HALLO
     256          call vlx_p(zq(1,1,iq),pente_max,zm(1,1,iq),mu,
     257     &               ij_begin+2*iip1,ij_end-2*iip1)
     258#endif       
     259        else if (iadv(iq)==14) then
     260#ifdef _ADV_HALLO
     261          call vlxqs_p(zq(1,1,iq),pente_max,zm(1,1,iq),mu,qsat,
     262     &                 ij_begin+2*iip1,ij_end-2*iip1)
     263#endif   
     264        else
     265       
     266          stop 'vlspltgen_p : schema non parallelise'
     267     
     268        endif
     269     
     270      enddo
     271c$OMP BARRIER     
     272c$OMP MASTER
     273      call VTb(VTHallo)
     274c$OMP END MASTER
     275
     276!      call WaitRecvRequest(MyRequest1)
     277!      call WaitSendRequest(MyRequest1)
     278c$OMP BARRIER
     279       call WaitRequest(MyRequest1)
     280
     281
     282c$OMP MASTER
    219283      call VTe(VTHallo)
    220284c$OMP END MASTER
    … …  
    243307       enddo
    244308
     309
    245310      do iq=1,nqmx
    246311
    … …  
    252317
    253318c$OMP BARRIER       
     319#ifdef _ADV_HALLO
     320          call vlz_p(zq(1,1,iq),pente_max,zm(1,1,iq),mw,
     321     &               ij_begin,ij_begin+2*iip1-1)
     322          call vlz_p(zq(1,1,iq),pente_max,zm(1,1,iq),mw,
     323     &               ij_end-2*iip1+1,ij_end)
     324#else
    254325          call vlz_p(zq(1,1,iq),pente_max,zm(1,1,iq),mw,
    255326     &               ij_begin,ij_end)
     327#endif
    256328c$OMP BARRIER
    257329
    258330c$OMP MASTER
    259331          call VTb(VTHallo)
     332c$OMP END MASTER
     333
    260334          call Register_Hallo(zq(1,1,iq),ip1jmp1,llm,2,2,2,2,MyRequest2)
    261335          call Register_Hallo(zm(1,1,iq),ip1jmp1,llm,1,1,1,1,MyRequest2)
     336
     337c$OMP MASTER
    262338          call VTe(VTHallo)
    263339c$OMP END MASTER       
    … …  
    271347      enddo
    272348c$OMP BARRIER     
     349
    273350c$OMP MASTER       
    274351      call VTb(VTHallo)
     352c$OMP END MASTER
     353
    275354      call SendRequest(MyRequest2)
    276       call WaitRecvRequest(MyRequest2)
    277       call WaitSendRequest(MyRequest2)
     355
     356c$OMP MASTER
     357      call VTe(VTHallo)
     358c$OMP END MASTER       
     359
     360c$OMP BARRIER
     361      do iq=1,nqmx
     362
     363        if(iadv(iq) == 0) then
     364         
     365          cycle
     366       
     367        else if (iadv(iq)==10 .or. iadv(iq)==14 ) then
     368c$OMP BARRIER       
     369
     370#ifdef _ADV_HALLO
     371          call vlz_p(zq(1,1,iq),pente_max,zm(1,1,iq),mw,
     372     &               ij_begin+2*iip1,ij_end-2*iip1)
     373#endif
     374
     375c$OMP BARRIER       
     376        else
     377       
     378          stop 'vlspltgen_p : schema non parallelise'
     379     
     380        endif
     381     
     382      enddo
     383
     384c$OMP BARRIER
     385c$OMP MASTER
     386      call VTb(VTHallo)
     387c$OMP END MASTER
     388
     389!      call WaitRecvRequest(MyRequest2)
     390!      call WaitSendRequest(MyRequest2)
     391c$OMP BARRIER
     392       CALL WaitRequest(MyRequest2)
     393
     394c$OMP MASTER
    278395      call VTe(VTHallo)
    279396c$OMP END MASTER
    … …  
    331448      ije=ij_end
    332449c$OMP BARRIER     
     450
    333451
    334452      DO iq=1,nqmx
Note: See TracChangeset for help on using the changeset viewer.