Ignore:
Timestamp:
Jul 19, 2013, 4:25:17 PM (11 years ago)
Author:
yann meurdesoif
Message:

Enable OpenMP parallelism using the guided mode.
=> Results are reproductible in mixed MPI/OpenMP parallel mode with different numbers of processes/tasks
=> Tested with the zoomed AMU version prepared by F. Hourdin
=> Need more extensive test

YM

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/trunk/libf/dyn3dmem/guide_loc_mod.F90

    r1733 r1806  
    295295    use parallel
    296296    USE control_mod
     297    USE write_field_loc
    297298   
    298299    IMPLICIT NONE
    … …  
    313314!$OMP THREADPRIVATE(first)
    314315    LOGICAL       :: f_out ! sortie guidage
    315     REAL, DIMENSION (ijb_u:ije_u,llm) :: f_add ! var aux: champ de guidage
     316    REAL, ALLOCATABLE, SAVE, DIMENSION (:,:) :: f_addu ! var aux: champ de guidage
     317    REAL, ALLOCATABLE, SAVE, DIMENSION (:,:) :: f_addv ! var aux: champ de guidage
    316318    ! Variables pour fonction Exner (P milieu couche)
    317     REAL, DIMENSION (iip1,jjb_u:jje_u,llm)    :: pk, pkf
    318     REAL, DIMENSION (iip1,jjb_u:jje_u,llm)    :: alpha, beta
    319     REAL, DIMENSION (iip1,jjb_u:jje_u)        :: pks   
     319    REAL, ALLOCATABLE, SAVE, DIMENSION (:,:,:)    :: pk, pkf
     320    REAL, ALLOCATABLE, SAVE, DIMENSION (:,:,:)    :: alpha, beta
     321    REAL, ALLOCATABLE, SAVE, DIMENSION (:,:)        :: pks   
    320322    REAL                               :: unskap
    321     REAL, DIMENSION (ijb_u:ije_u,llmp1)    :: p ! besoin si guide_P
     323    REAL, ALLOCATABLE, SAVE, DIMENSION (:,:)    :: p ! besoin si guide_P
    322324    ! Compteurs temps:
    323325    INTEGER, SAVE :: step_rea,count_no_rea,itau_test ! lecture guidage
    … …  
    329331   
    330332    INTEGER       :: i,j,l
    331    
     333      
    332334!$OMP MASTER   
    333335    ijbu=ij_begin ; ijeu=ij_end ; ijnu=ijeu-ijbu+1 
    … …  
    358360        first=.FALSE.
    359361!$OMP MASTER
     362        ALLOCATE(f_addu(ijb_u:ije_u,llm) )
     363        ALLOCATE(f_addv(ijb_v:ije_v,llm) )
     364        ALLOCATE(pk(iip1,jjb_u:jje_u,llm)  )
     365        ALLOCATE(pkf(iip1,jjb_u:jje_u,llm)  )
     366        ALLOCATE(alpha(iip1,jjb_u:jje_u,llm)  )
     367        ALLOCATE(beta(iip1,jjb_u:jje_u,llm)  )
     368        ALLOCATE(pks(iip1,jjb_u:jje_u)  )
     369        ALLOCATE(p(ijb_u:ije_u,llmp1) )
    360370        CALL guide_init
    361371!$OMP END MASTER
    … …  
    367377        factt=dtvr*iperiod/daysec
    368378!$OMP MASTER
    369         call tau2alpha(3,iip1,jjnb_v ,factt,tau_min_v,tau_max_v,alpha_v)
    370         call tau2alpha(2,iip1,jjnb_u,factt,tau_min_u,tau_max_u,alpha_u)
    371         call tau2alpha(1,iip1,jjnb_u,factt,tau_min_T,tau_max_T,alpha_T)
    372         call tau2alpha(1,iip1,jjnb_u,factt,tau_min_P,tau_max_P,alpha_P)
    373         call tau2alpha(1,iip1,jjnb_u,factt,tau_min_Q,tau_max_Q,alpha_Q)
     379        call tau2alpha(3, iip1, jjb_v, jje_v, factt, tau_min_v, tau_max_v, alpha_v)
     380        call tau2alpha(2, iip1, jjb_u, jje_u, factt, tau_min_u, tau_max_u, alpha_u)
     381        call tau2alpha(1, iip1, jjb_u, jje_u, factt, tau_min_T, tau_max_T, alpha_T)
     382        call tau2alpha(1, iip1, jjb_u, jje_u, factt, tau_min_P, tau_max_P, alpha_P)
     383        call tau2alpha(1, iip1, jjb_u, jje_u, factt, tau_min_Q, tau_max_Q, alpha_Q)
    374384! correction de rappel dans couche limite
    375385        if (guide_BL) then
    … …  
    381391        endif
    382392!$OMP END MASTER
     393!$OMP BARRIER
    383394! ini_anal: etat initial egal au guidage       
    384395        IF (ini_anal) THEN
    385396            CALL guide_interp(ps,teta)
    386             IF (guide_u) ucov(ijbu:ijeu,:)=ugui2(ijbu:ijeu,:)
    387             IF (guide_v) vcov(ijbv:ijev,:)=ugui2(ijbv:ijev,:)
    388             IF (guide_T) teta(ijbu:ijeu,:)=tgui2(ijbu:ijeu,:)
    389             IF (guide_Q) q(ijbu:ijeu,:)=qgui2(ijbu:ijeu,:)
     397!$OMP DO           
     398            DO l=1,llm
     399              IF (guide_u) ucov(ijbu:ijeu,l)=ugui2(ijbu:ijeu,l)
     400              IF (guide_v) vcov(ijbv:ijev,l)=ugui2(ijbv:ijev,l)
     401              IF (guide_T) teta(ijbu:ijeu,l)=tgui2(ijbu:ijeu,l)
     402              IF (guide_Q) q(ijbu:ijeu,l)=qgui2(ijbu:ijeu,l)
     403            ENDDO
     404           
    390405            IF (guide_P) THEN
     406!$OMP MASTER
    391407                ps(ijbu:ijeu)=psgui2(ijbu:ijeu)
     408!$OMP END MASTER
     409!$OMP BARRIER
    392410                CALL pression_loc(ijnb_u,ap,bp,ps,p)
    393411                CALL massdair_loc(p,masse)
     412!$OMP BARRIER
    394413            ENDIF
    395414            RETURN
    … …  
    398417        IF (guide_u) THEN
    399418!+tard            CALL writefield_u('unat',unat1)
    400             CALL writefield_u('ucov',ucov)
     419!            CALL writefield_u('ucov',ucov)
    401420        ENDIF
    402421        IF (guide_T) THEN
    403422!+tard            CALL writefield_p('tnat',tnat1)
    404             CALL writefield_u('teta',teta)
     423!            CALL writefield_u('teta',teta)
    405424        ENDIF
    406425
    … …  
    424443              stop
    425444          ELSE
     445!$OMP MASTER
    426446              IF (guide_v) vnat1(:,jjbv:jjev,:)=vnat2(:,jjbv:jjev,:)
    427447              IF (guide_u) unat1(:,jjbu:jjeu,:)=unat2(:,jjbu:jjeu,:)
    … …  
    430450              IF (guide_plevs.EQ.2) pnat1(:,jjbu:jjeu,:)=pnat2(:,jjbu:jjeu,:)
    431451              IF (guide_P.OR.guide_plevs.EQ.1) psnat1(:,jjbu:jjeu)=psnat2(:,jjbu:jjeu)
     452!$OMP END MASTER
     453!$OMP BARRIER
    432454              step_rea=step_rea+1
    433455              itau_test=itau
    … …  
    435457                    'apres ',count_no_rea,' non lectures'
    436458              IF (guide_2D) THEN
     459!$OMP MASTER
    437460                  CALL guide_read2D(step_rea)
     461!$OMP END MASTER
     462!$OMP BARRIER
    438463              ELSE
     464!$OMP MASTER
    439465                  CALL guide_read(step_rea)
     466!$OMP END MASTER
     467!$OMP BARRIER
    440468              ENDIF
    441469              count_no_rea=0
    … …  
    460488    ENDIF
    461489
    462 !-----------------------------------------------------------------------
     490!    CALL WriteField_u('ucov_guide',ucov)
     491!    CALL WriteField_v('vcov_guide',vcov)
     492!    CALL WriteField_u('teta_guide',teta)
     493!    CALL WriteField_u('masse_guide',masse)
     494   
     495   
     496        !-----------------------------------------------------------------------
    463497!   Ajout des champs de guidage
    464498!-----------------------------------------------------------------------
    … …  
    473507          CALL exner_milieu_loc(ip1jmp1,ps,p,beta,pks,pk,pkf)
    474508        endif
     509!$OMP BARRIER       
    475510        unskap=1./kappa
     511!$OMP DO
    476512        DO l = 1, llm
    477513            DO j=jjbu,jjeu
    … …  
    481517            ENDDO
    482518        ENDDO
     519!$OMP MASTER
    483520        CALL guide_out("P",jjp1,llm,p,1.)
     521!$OMP END MASTER
     522!$OMP BARRIER
    484523    ENDIF
    485524   
    486525    if (guide_u) then
    487526        if (guide_add) then
    488            f_add(ijbu:ijeu,:)=(1.-tau)*ugui1(ijbu:ijeu,:)+tau*ugui2(ijbu:ijeu,:)
     527!$OMP DO
     528          DO l=1,llm
     529           f_addu(ijbu:ijeu,l)=(1.-tau)*ugui1(ijbu:ijeu,l)+tau*ugui2(ijbu:ijeu,l)
     530          ENDDO
    489531        else
    490            f_add(ijbu:ijeu,:)=(1.-tau)*ugui1(ijbu:ijeu,:)+tau*ugui2(ijbu:ijeu,:)-ucov(ijbu:ijeu,:)
     532!$OMP DO
     533          DO l=1,llm
     534           f_addu(ijbu:ijeu,l)=(1.-tau)*ugui1(ijbu:ijeu,l)+tau*ugui2(ijbu:ijeu,l)-ucov(ijbu:ijeu,l)
     535          ENDDO
    491536        endif
    492 
    493         if (guide_zon) CALL guide_zonave_u(1,llm,f_add)
    494         CALL guide_addfield_u(llm,f_add,alpha_u)
    495         IF (f_out) CALL guide_out("U",jjp1,llm,f_add(:,:),factt)
    496         ucov(ijbu:ijeu,:)=ucov(ijbu:ijeu,:)+f_add(ijbu:ijeu,:)
     537   
     538!        CALL WriteField_u('f_addu',f_addu)
     539
     540        if (guide_zon) CALL guide_zonave_u(1,llm,f_addu)
     541        CALL guide_addfield_u(llm,f_addu,alpha_u)
     542!        CALL WriteField_u('f_addu',f_addu)
     543!        CALL WriteField_u('alpha_u',alpha_u)
     544!$OMP MASTER
     545        IF (f_out) CALL guide_out("U",jjp1,llm,f_addu(:,:),factt)
     546!$OMP END MASTER
     547!$OMP BARRIER
     548
     549!$OMP DO
     550        DO l=1,llm
     551          ucov(ijbu:ijeu,l)=ucov(ijbu:ijeu,l)+f_addu(ijbu:ijeu,l)
     552        ENDDO
     553
    497554    endif
    498555
    499556    if (guide_T) then
    500557        if (guide_add) then
    501            f_add(ijbu:ijeu,:)=(1.-tau)*tgui1(ijbu:ijeu,:)+tau*tgui2(ijbu:ijeu,:)
     558!$OMP DO
     559          DO l=1,llm
     560            f_addu(ijbu:ijeu,l)=(1.-tau)*tgui1(ijbu:ijeu,l)+tau*tgui2(ijbu:ijeu,l)
     561          ENDDO
    502562        else
    503            f_add(ijbu:ijeu,:)=(1.-tau)*tgui1(ijbu:ijeu,:)+tau*tgui2(ijbu:ijeu,:)-teta(ijbu:ijeu,:)
     563!$OMP DO
     564          DO l=1,llm
     565           f_addu(ijbu:ijeu,l)=(1.-tau)*tgui1(ijbu:ijeu,l)+tau*tgui2(ijbu:ijeu,l)-teta(ijbu:ijeu,l)
     566          ENDDO
    504567        endif
    505         if (guide_zon) CALL guide_zonave_u(2,llm,f_add)
    506         CALL guide_addfield_u(llm,f_add,alpha_T)
    507         IF (f_out) CALL guide_out("T",jjp1,llm,f_add(:,:),factt)
    508         teta(ijbu:ijeu,:)=teta(ijbu:ijeu,:)+f_add(ijbu:ijeu,:)
     568        if (guide_zon) CALL guide_zonave_u(2,llm,f_addu)
     569        CALL guide_addfield_u(llm,f_addu,alpha_T)
     570!$OMP MASTER
     571        IF (f_out) CALL guide_out("T",jjp1,llm,f_addu(:,:),factt)
     572!$OMP END MASTER
     573!$OMP BARRIER
     574!$OMP DO
     575        DO l=1,llm
     576          teta(ijbu:ijeu,l)=teta(ijbu:ijeu,l)+f_addu(ijbu:ijeu,l)
     577        ENDDO
    509578    endif
    510579
    511580    if (guide_P) then
    512581        if (guide_add) then
    513            f_add(ijbu:ijeu,1)=(1.-tau)*psgui1(ijbu:ijeu)+tau*psgui2(ijbu:ijeu)
     582!$OMP MASTER
     583            f_addu(ijbu:ijeu,1)=(1.-tau)*psgui1(ijbu:ijeu)+tau*psgui2(ijbu:ijeu)
     584!$OMP END MASTER
     585!$OMP BARRIER
    514586        else
    515            f_add(ijbu:ijeu,1)=(1.-tau)*psgui1(ijbu:ijeu)+tau*psgui2(ijbu:ijeu)-ps(ijbu:ijeu)
     587!$OMP MASTER
     588            f_addu(ijbu:ijeu,1)=(1.-tau)*psgui1(ijbu:ijeu)+tau*psgui2(ijbu:ijeu)-ps(ijbu:ijeu)
     589!$OMP END MASTER
     590!$OMP BARRIER
    516591        endif
    517         if (guide_zon) CALL guide_zonave_u(2,1,f_add(ijb_u:ije_u,1))
    518         CALL guide_addfield_u(1,f_add(ijb_u:ije_u,1),alpha_P)
    519         IF (f_out) CALL guide_out("SP",jjp1,1,f_add(1:ip1jmp1,1),factt)
    520         ps(ijbu:ijeu)=ps(ijbu:ijeu)+f_add(ijbu:ijeu,1)
     592        if (guide_zon) CALL guide_zonave_u(2,1,f_addu(ijb_u:ije_u,1))
     593        CALL guide_addfield_u(1,f_addu(ijb_u:ije_u,1),alpha_P)
     594!$OMP MASTER
     595        IF (f_out) CALL guide_out("SP",jjp1,1,f_addu(1:ip1jmp1,1),factt)
     596!$OMP END MASTER
     597!$OMP BARRIER
     598!$OMP MASTER
     599        ps(ijbu:ijeu)=ps(ijbu:ijeu)+f_addu(ijbu:ijeu,1)
     600!$OMP END MASTER
     601!$OMP BARRIER
    521602        CALL pression_loc(ijnb_u,ap,bp,ps,p)
    522603        CALL massdair_loc(p,masse)
     604!$OMP BARRIER
    523605    endif
    524606
    525607    if (guide_Q) then
    526608        if (guide_add) then
    527            f_add(ijbu:ijeu,:)=(1.-tau)*qgui1(ijbu:ijeu,:)+tau*qgui2(ijbu:ijeu,:)
     609!$OMP DO
     610          DO l=1,llm
     611            f_addu(ijbu:ijeu,l)=(1.-tau)*qgui1(ijbu:ijeu,l)+tau*qgui2(ijbu:ijeu,l)
     612          ENDDO
    528613        else
    529            f_add(ijbu:ijeu,:)=(1.-tau)*qgui1(ijbu:ijeu,:)+tau*qgui2(ijbu:ijeu,:)-q(ijbu:ijeu,:)
     614!$OMP DO
     615          DO l=1,llm
     616            f_addu(ijbu:ijeu,l)=(1.-tau)*qgui1(ijbu:ijeu,l)+tau*qgui2(ijbu:ijeu,l)-q(ijbu:ijeu,l)
     617          ENDDO
    530618        endif
    531         if (guide_zon) CALL guide_zonave_u(2,llm,f_add)
    532         CALL guide_addfield_u(llm,f_add,alpha_Q)
    533         IF (f_out) CALL guide_out("Q",jjp1,llm,f_add(:,:),factt)
    534         q(ijbu:ijeu,:)=q(ijbu:ijeu,:)+f_add(ijbu:ijeu,:)
     619        if (guide_zon) CALL guide_zonave_u(2,llm,f_addu)
     620        CALL guide_addfield_u(llm,f_addu,alpha_Q)
     621!$OMP MASTER
     622        IF (f_out) CALL guide_out("Q",jjp1,llm,f_addu(:,:),factt)
     623!$OMP END MASTER
     624!$OMP BARRIER
     625
     626!$OMP DO
     627        DO l=1,llm
     628          q(ijbu:ijeu,l)=q(ijbu:ijeu,l)+f_addu(ijbu:ijeu,l)
     629        ENDDO
    535630    endif
    536631
    537632    if (guide_v) then
    538633        if (guide_add) then
    539            f_add(ijbv:ijev,:)=(1.-tau)*vgui1(ijbv:ijev,:)+tau*vgui2(ijbv:ijev,:)
     634!$OMP DO
     635          DO l=1,llm
     636             f_addv(ijbv:ijev,l)=(1.-tau)*vgui1(ijbv:ijev,l)+tau*vgui2(ijbv:ijev,l)
     637          ENDDO
     638
    540639        else
    541            f_add(ijbv:ijev,:)=(1.-tau)*vgui1(ijbv:ijev,:)+tau*vgui2(ijbv:ijev,:)-vcov(ijbv:ijev,:)
     640!$OMP DO
     641          DO l=1,llm
     642            f_addv(ijbv:ijev,l)=(1.-tau)*vgui1(ijbv:ijev,l)+tau*vgui2(ijbv:ijev,l)-vcov(ijbv:ijev,l)
     643          ENDDO
     644
    542645        endif
     646!        CALL WriteField_v('f_addv',f_addv)       
     647   
     648        if (guide_zon) CALL guide_zonave_v(2,jjm,llm,f_addv(ijb_v:ije_v,:))
     649!        CALL WriteField_v('f_addv',f_addv)       
    543650       
    544         if (guide_zon) CALL guide_zonave_v(2,jjm,llm,f_add(ijb_v:ije_v,:))
    545         CALL guide_addfield_v(llm,f_add(ijb_v:ije_v,:),alpha_v)
    546         IF (f_out) CALL guide_out("V",jjm,llm,f_add(1:ip1jm,:),factt)
    547         vcov(ijbv:ijev,:)=vcov(ijbv:ijev,:)+f_add(ijbv:ijev,:)
     651        CALL guide_addfield_v(llm,f_addv(ijb_v:ije_v,:),alpha_v)
     652!        CALL WriteField_v('f_addv',f_addv)       
     653!        CALL WriteField_v('alpha_v',alpha_v)       
     654!$OMP MASTER
     655        IF (f_out) CALL guide_out("V",jjm,llm,f_addv(1:ip1jm,:),factt)
     656!$OMP END MASTER
     657!$OMP BARRIER
     658!        CALL WriteField_v('f_addv',f_addv)       
     659
     660!$OMP DO
     661        DO l=1,llm
     662          vcov(ijbv:ijev,l)=vcov(ijbv:ijev,l)+f_addv(ijbv:ijev,l)
     663        ENDDO
    548664    endif
     665
     666!    CALL WriteField_u('ucov_guide',ucov)
     667!    CALL WriteField_v('vcov_guide',vcov)
     668!    CALL WriteField_u('teta_guide',teta)
     669!    CALL WriteField_u('masse_guide',masse)
    549670
    550671  END SUBROUTINE guide_main
    … …  
    566687    INTEGER :: l
    567688
     689!$OMP DO
    568690    DO l=1,vsize
    569691      field(ijbu:ijeu,l)=alpha(ijbu:ijeu)*field(ijbu:ijeu,l)*alpha_pcor(l)
    … …  
    588710    INTEGER :: l
    589711
     712!$OMP DO
    590713    DO l=1,vsize
    591714      field(ijbv:ijev,l)=alpha(ijbv:ijev)*field(ijbv:ijev,l)*alpha_pcor(l)
    … …  
    612735    ! Local variables
    613736    LOGICAL, SAVE                :: first=.TRUE.
     737!$OMP THREADPRIVATE(first)
     738
    614739    INTEGER, DIMENSION (2), SAVE :: imin, imax ! averaging domain
     740!$OMP THREADPRIVATE(imin,imax)   
    615741    INTEGER                      :: i,j,l,ij
    616742    REAL, DIMENSION (iip1)       :: lond       ! longitude in Deg.
    … …  
    636762    ENDIF
    637763
    638     fieldm=0.
    639    
     764   
     765!$OMP DO
    640766      DO l=1,vsize
     767        fieldm(:,l)=0.
    641768      ! Compute zonal average
    642769
    … …  
    680807    ! Local variables
    681808    LOGICAL, SAVE                :: first=.TRUE.
     809!$OMP THREADPRIVATE(first)
    682810    INTEGER, DIMENSION (2), SAVE :: imin, imax ! averaging domain
     811!$OMP THREADPRIVATE(imin, imax)
    683812    INTEGER                      :: i,j,l,ij
    684813    REAL, DIMENSION (iip1)       :: lond       ! longitude in Deg.
    … …  
    704833    ENDIF
    705834
    706     fieldm=0.
    707    
     835!$OMP DO
    708836      DO l=1,vsize
    709837      ! Compute zonal average
     838          fieldm(:,l)=0.
    710839          DO j=jjbv,jjev
    711840              DO i=imin(typ),imax(typ)
    … …  
    744873
    745874  LOGICAL, SAVE                      :: first=.TRUE.
     875!$OMP THREADPRIVATE(first)
    746876  ! Variables pour niveaux pression:
    747   REAL, DIMENSION (iip1,jjb_u:jje_u,nlevnc) :: plnc1,plnc2 !niveaux pression guidage
    748   REAL, DIMENSION (iip1,jjb_u:jje_u,llm)    :: plunc,plsnc !niveaux pression modele
    749   REAL, DIMENSION (iip1,jjb_v:jje_v,llm)     :: plvnc       !niveaux pression modele
    750   REAL, DIMENSION (iip1,jjb_u:jje_u,llmp1)  :: p           ! pression intercouches
    751   REAL, DIMENSION (iip1,jjb_u:jje_u,llm)    :: pls, pext   ! var intermediaire
    752   REAL, DIMENSION (iip1,jjb_u:jje_u,llm)    :: pbarx
    753   REAL, DIMENSION (iip1,jjb_v:jje_v,llm)     :: pbary
     877  REAL, ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: plnc1,plnc2 !niveaux pression guidage
     878  REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:)    :: plunc,plsnc !niveaux pression modele
     879  REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:)     :: plvnc       !niveaux pression modele
     880  REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:)  :: p           ! pression intercouches
     881  REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:)    :: pls, pext   ! var intermediaire
     882  REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:)    :: pbarx
     883  REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:)     :: pbary
    754884  ! Variables pour fonction Exner (P milieu couche)
    755   REAL, DIMENSION (iip1,jjb_u:jje_u,llm)    :: pk, pkf
    756   REAL, DIMENSION (iip1,jjb_u:jje_u,llm)    :: alpha, beta
    757   REAL, DIMENSION (iip1,jjb_u:jje_u)        :: pks   
     885  REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:)    :: pk, pkf
     886  REAL, ALLOCATABLE, SAVE, DIMENSION (:,:,:)    :: alpha, beta
     887  REAL ,ALLOCATABLE, SAVE, DIMENSION (:,:)        :: pks   
    758888  REAL                               :: unskap
    759889  ! Pression de vapeur saturante
    760   REAL, DIMENSION (ijb_u:ije_u,llm)      :: qsat
     890  REAL, ALLOCATABLE, SAVE,DIMENSION (:,:)      :: qsat
    761891  !Variables intermediaires interpolation
    762   REAL, DIMENSION (iip1,jjb_u:jje_u,llm)    :: zu1,zu2
    763   REAL, DIMENSION (iip1,jjb_v:jje_v,llm)     :: zv1,zv2
     892  REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:)    :: zu1,zu2
     893  REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:)     :: zv1,zv2
    764894 
    765895  INTEGER                            :: i,j,l,ij
    … …  
    770900! Calcul des niveaux de pression champs guidage (pour T et Q)
    771901! -----------------------------------------------------------------
     902    IF (first) THEN
     903!$OMP MASTER
     904      ALLOCATE(plnc1(iip1,jjb_u:jje_u,nlevnc) )   
     905      ALLOCATE(plnc2(iip1,jjb_u:jje_u,nlevnc) )   
     906      ALLOCATE(plunc(iip1,jjb_u:jje_u,llm) )   
     907      ALLOCATE(plsnc(iip1,jjb_u:jje_u,llm) )   
     908      ALLOCATE(plvnc(iip1,jjb_v:jje_v,llm) )   
     909      ALLOCATE(p(iip1,jjb_u:jje_u,llmp1) )   
     910      ALLOCATE(pls(iip1,jjb_u:jje_u,llm) )   
     911      ALLOCATE(pext(iip1,jjb_u:jje_u,llm) )   
     912      ALLOCATE(pbarx(iip1,jjb_u:jje_u,llm) )   
     913      ALLOCATE(pbary(iip1,jjb_v:jje_v,llm) )   
     914      ALLOCATE(pk(iip1,jjb_u:jje_u,llm) )   
     915      ALLOCATE(pkf(iip1,jjb_u:jje_u,llm)  )   
     916      ALLOCATE(alpha(iip1,jjb_u:jje_u,llm) )   
     917      ALLOCATE(beta(iip1,jjb_u:jje_u,llm) )   
     918      ALLOCATE(pks (iip1,jjb_u:jje_u) )   
     919      ALLOCATE(qsat(ijb_u:ije_u,llm) )   
     920      ALLOCATE(zu1(iip1,jjb_u:jje_u,llm) )   
     921      ALLOCATE(zu2(iip1,jjb_u:jje_u,llm) )   
     922      ALLOCATE(zv1(iip1,jjb_v:jje_v,llm) )   
     923      ALLOCATE(zv2(iip1,jjb_v:jje_v,llm) )
     924!$OMP END MASTER
     925!$OMP BARRIER
     926    ENDIF       
     927
     928   
     929   
     930   
    772931    IF (guide_plevs.EQ.0) THEN
     932!$OMP DO
    773933        DO l=1,nlevnc
    774934            DO j=jjbu,jjeu
    … …  
    783943    if (first) then
    784944        first=.FALSE.
     945!$OMP MASTER
    785946        print*,'Guide: verification ordre niveaux verticaux'
    786947        print*,'LMDZ :'
    … …  
    815976            enddo
    816977        endif
     978!$OMP END MASTER
    817979    endif
    818980   
    … …  
    823985!    ....  Calcul de pls , pression au milieu des couches ,en Pascals
    824986    IF (guide_plevs.EQ.1) THEN
     987!$OMP DO
    825988        DO l=1,llm
    826989            DO j=jjbu,jjeu
    … …  
    8381001        endif
    8391002        unskap=1./kappa
     1003!$OMP BARRIER
     1004!$OMP DO
    8401005        DO l = 1, llm
    8411006            DO j=jjbu,jjeu
    … …  
    8481013
    8491014!   calcul des pressions pour les grilles u et v
     1015!$OMP DO
    8501016    do l=1,llm
    8511017        do j=jjbu,jjeu
    … …  
    8581024     CALL Register_Hallo_u(pext,llm,1,2,2,1,Req)
    8591025     CALL SendRequest(Req)
     1026!$OMP BARRIER
    8601027     CALL WaitRequest(Req)
     1028!$OMP BARRIER
    8611029
    8621030    call massbar_loc(pext, pbarx, pbary )
     1031!$OMP BARRIER
     1032!$OMP DO
    8631033    do l=1,llm
    8641034        do j=jjbu,jjeu
    … …  
    8691039        enddo
    8701040    enddo
     1041!$OMP DO
    8711042    do l=1,llm
    8721043        do j=jjbv,jjev
    … …  
    8821053! -----------------------------------------------------------------
    8831054    if (guide_P) then
     1055!$OMP MASTER
    8841056        do j=jjbu,jjeu
    8851057            do i=1,iim
    … …  
    8911063            psgui2(iip1*j)=psnat2(1,j)
    8921064        enddo
     1065!$OMP END MASTER
     1066!$OMP BARRIER
    8931067    endif
    8941068
    … …  
    8961070        ! Calcul des nouvelles valeurs des niveaux de pression du guidage
    8971071        IF (guide_plevs.EQ.1) THEN
     1072!$OMP DO
    8981073            DO l=1,nlevnc
    8991074                DO j=jjbu,jjeu
    … …  
    9051080            ENDDO
    9061081        ELSE IF (guide_plevs.EQ.2) THEN
     1082!$OMP DO
    9071083            DO l=1,nlevnc
    9081084                DO j=jjbu,jjeu
    … …  
    9161092
    9171093        ! Interpolation verticale
     1094!$OMP MASTER
    9181095        CALL pres2lev(tnat1(:,jjbu:jjeu,:),zu1(:,jjbu:jjeu,:),nlevnc,llm,           &
    9191096                    plnc1(:,jjbu:jjeu,:),plsnc(:,jjbu:jjeu,:),iip1,jjnu,invert_p)
    9201097        CALL pres2lev(tnat2(:,jjbu:jjeu,:),zu2(:,jjbu:jjeu,:),nlevnc,llm,           &
    9211098                    plnc2(:,jjbu:jjeu,:),plsnc(:,jjbu:jjeu,:),iip1,jjnu,invert_p)
    922 
     1099!$OMP END MASTER
     1100!$OMP BARRIER
    9231101        ! Conversion en variables GCM
     1102!$OMP DO
    9241103        do l=1,llm
    9251104            do j=jjbu,jjeu
    … …  
    9581137        ! Calcul des nouvelles valeurs des niveaux de pression du guidage
    9591138        IF (guide_plevs.EQ.1) THEN
     1139!$OMP DO
    9601140            DO l=1,nlevnc
    9611141                DO j=jjbu,jjeu
    … …  
    9671147            ENDDO
    9681148        ELSE IF (guide_plevs.EQ.2) THEN
     1149!$OMP DO
    9691150            DO l=1,nlevnc
    9701151                DO j=jjbu,jjeu
    … …  
    9781159
    9791160        ! Interpolation verticale
     1161!$OMP MASTER
    9801162        CALL pres2lev(qnat1(:,jjbu:jjeu,:),zu1(:,jjbu:jjeu,:),nlevnc,llm,             &
    9811163                      plnc1(:,jjbu:jjeu,:),plsnc(:,jjbu:jjeu,:),iip1,jjnu,invert_p)
    9821164        CALL pres2lev(qnat2(:,jjbu:jjeu,:),zu2(:,jjbu:jjeu,:),nlevnc,llm,             &
    9831165                      plnc2(:,jjbu:jjeu,:),plsnc(:,jjbu:jjeu,:),iip1,jjnu,invert_p)
     1166!$OMP END MASTER
     1167!$OMP BARRIER
    9841168
    9851169        ! Conversion en variables GCM
    9861170        ! On suppose qu'on a la bonne variable dans le fichier de guidage:
    9871171        ! Hum.Rel si guide_hr, Hum.Spec. sinon.
     1172!$OMP DO
    9881173        do l=1,llm
    9891174            do j=jjbu,jjeu
    … …  
    10101195        enddo
    10111196        IF (guide_hr) THEN
    1012             CALL q_sat(iip1*jjnu*llm,teta(:,jjbu:jjeu,:)*pk(:,jjbu:jjeu,:)/cpp,       &
    1013                        plsnc(:,jjbu:jjeu,:),qsat(ijbu:ijeu,:))
    1014             qgui1(ijbu:ijeu,:)=qgui1(ijbu:ijeu,:)*qsat(ijbu:ijeu,:)*0.01 !hum. rel. en %
    1015             qgui2(ijbu:ijeu,:)=qgui2(ijbu:ijeu,:)*qsat(ijbu:ijeu,:)*0.01
     1197!$OMP DO
     1198          do l=1,llm
     1199            CALL q_sat(iip1*jjnu,teta(:,jjbu:jjeu,l)*pk(:,jjbu:jjeu,l)/cpp,       &
     1200                       plsnc(:,jjbu:jjeu,l),qsat(ijbu:ijeu,l))
     1201            qgui1(ijbu:ijeu,l)=qgui1(ijbu:ijeu,l)*qsat(ijbu:ijeu,l)*0.01 !hum. rel. en %
     1202            qgui2(ijbu:ijeu,l)=qgui2(ijbu:ijeu,l)*qsat(ijbu:ijeu,l)*0.01
     1203          enddo
     1204
    10161205        ENDIF
    10171206    ENDIF
    … …  
    10201209        ! Calcul des nouvelles valeurs des niveaux de pression du guidage
    10211210        IF (guide_plevs.EQ.1) THEN
     1211!$OMP DO
    10221212            DO l=1,nlevnc
    10231213                DO j=jjbu,jjeu
    … …  
    10331223            ENDDO
    10341224        ELSE IF (guide_plevs.EQ.2) THEN
     1225!$OMP DO
    10351226            DO l=1,nlevnc
    10361227                DO j=jjbu,jjeu
    … …  
    10481239       
    10491240        ! Interpolation verticale
     1241!$OMP MASTER
    10501242        CALL pres2lev(unat1(:,jjbu:jjeu,:),zu1(:,jjbu:jjeu,:),nlevnc,llm,            &
    10511243                      plnc1(:,jjbu:jjeu,:),plunc(:,jjbu:jjeu,:),iip1,jjnu,invert_p)
    10521244        CALL pres2lev(unat2(:,jjbu:jjeu,:),zu2(:,jjbu:jjeu,:),nlevnc,llm,            &
    10531245                      plnc2(:,jjbu:jjeu,:),plunc(:,jjbu:jjeu,:),iip1,jjnu,invert_p)
     1246!$OMP END MASTER
     1247!$OMP BARRIER
    10541248
    10551249        ! Conversion en variables GCM
     1250!$OMP DO
    10561251        do l=1,llm
    10571252            do j=jjbu,jjeu
    … …  
    10851280         CALL Register_Hallo_u(psnat2,1,1,2,2,1,Req)
    10861281         CALL SendRequest(Req)
     1282!$OMP BARRIER
    10871283         CALL WaitRequest(Req)
     1284!$OMP BARRIER
     1285!$OMP DO
    10881286            DO l=1,nlevnc
    10891287                DO j=jjbv,jjev
    … …  
    11001298         CALL Register_Hallo_u(pnat2,llm,1,2,2,1,Req)
    11011299         CALL SendRequest(Req)
     1300!$OMP BARRIER
    11021301         CALL WaitRequest(Req)
     1302!$OMP BARRIER
     1303!$OMP DO
    11031304            DO l=1,nlevnc
    11041305                DO j=jjbv,jjev
    … …  
    11131314        ENDIF
    11141315        ! Interpolation verticale
     1316
     1317!$OMP MASTER
    11151318        CALL pres2lev(vnat1(:,jjbv:jjev,:),zv1(:,jjbv:jjev,:),nlevnc,llm,             &
    11161319                      plnc1(:,jjbv:jjev,:),plvnc(:,jjbv:jjev,:),iip1,jjnv,invert_p)
    11171320        CALL pres2lev(vnat2(:,jjbv:jjev,:),zv2(:,jjbv:jjev,:),nlevnc,llm,             &
    11181321                      plnc2(:,jjbv:jjev,:),plvnc(:,jjbv:jjev,:),iip1,jjnv,invert_p)
     1322!$OMP END MASTER
     1323!$OMP BARRIER
    11191324        ! Conversion en variables GCM
     1325!$OMP DO
    11201326        do l=1,llm
    11211327            do j=jjbv,jjev
    … …  
    11351341
    11361342!=======================================================================
    1137   SUBROUTINE tau2alpha(typ,pim,pjm,factt,taumin,taumax,alpha)
     1343  SUBROUTINE tau2alpha(typ,pim,jjb,jje,factt,taumin,taumax,alpha)
    11381344
    11391345! Calcul des constantes de rappel alpha (=1/tau)
    … …  
    11491355! input arguments :
    11501356    INTEGER, INTENT(IN) :: typ    ! u(2),v(3), ou scalaire(1)
    1151     INTEGER, INTENT(IN) :: pim,pjm ! dimensions en lat, lon
     1357    INTEGER, INTENT(IN) :: pim ! dimensions en lon
     1358    INTEGER, INTENT(IN) :: jjb,jje ! dimensions en lat
    11521359    REAL, INTENT(IN)    :: factt   ! pas de temps en fraction de jour
    11531360    REAL, INTENT(IN)    :: taumin,taumax
    11541361! output arguments:
    1155     REAL, DIMENSION(pim,pjm), INTENT(OUT) :: alpha
     1362    REAL, DIMENSION(pim,jjb:jje), INTENT(OUT) :: alpha
    11561363 
    11571364!  local variables:
    … …  
    11751382!-----------------------------------------------------------------------
    11761383        IF (guide_reg) THEN
    1177             do j=1,pjm
     1384            do j=jjb,jje
    11781385                do i=1,pim
    11791386                    if (typ.eq.2) then
    … …  
    12711478        ENDIF !first
    12721479
    1273         do j=1,pjm
     1480        do j=jjb,jje
    12741481            do i=1,pim
    12751482                if (typ.eq.1) then
    … …  
    12971504            enddo
    12981505        enddo
     1506   
    12991507    ENDIF ! guide_reg
    13001508
Note: See TracChangeset for help on using the changeset viewer.