Ignore:
Timestamp:
May 5, 2014, 11:38:45 AM (11 years ago)
Author:
fhourdin
Message:

Correction de la version openMP du guidage
Bug fixing for openMP

File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r2034 r2036  
    368368   
    369369    INTEGER       :: i,j,l
     370    INTEGER,EXTERNAL :: OMP_GET_THREAD_NUM
    370371       
    371372!$OMP MASTER   
    … …  
    383384!$OMP BARRIER
    384385     
    385      PRINT *,'---> on rentre dans guide_main'
     386!    PRINT *,'---> on rentre dans guide_main'
    386387!    CALL AllGather_Field(ucov,ip1jmp1,llm)
    387388!    CALL AllGather_Field(vcov,ip1jm,llm)
    … …  
    429430        IF (ini_anal) THEN
    430431            CALL guide_interp(ps,teta)
    431 !$OMP DO            
     432!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)            
    432433            DO l=1,llm
    433434              IF (guide_u) ucov(ijbu:ijeu,l)=ugui2(ijbu:ijeu,l)
    … …  
    447448            ENDIF
    448449            RETURN
    449         ENDIF
    450 ! Verification structure guidage
    451         IF (guide_u) THEN
    452 !+tard            CALL writefield_u('unat',unat1)
    453 !            CALL writefield_u('ucov',ucov)
    454         ENDIF
    455         IF (guide_T) THEN
    456 !+tard            CALL writefield_p('tnat',tnat1)
    457 !            CALL writefield_u('teta',teta)
    458450        ENDIF
    459451
    … …  
    534526    f_out=((MOD(itau,iguide_sav).EQ.0).AND.guide_sav) 
    535527    IF (f_out) THEN
    536 !       Calcul niveaux pression milieu de couches
    537         CALL pression_loc( ijnb_u, ap, bp, ps, p )
    538         if (pressure_exner) then
    539           CALL exner_hyb_loc(ip1jmp1,ps,p,pks,pk)
    540         else
    541           CALL exner_milieu_loc(ip1jmp1,ps,p,pks,pk)
    542         endif
    543 !$OMP BARRIER       
     528
     529!$OMP BARRIER
     530      CALL pression_loc(ijnb_u,ap,bp,ps,p)
     531
     532!$OMP BARRIER
     533      if (pressure_exner) then
     534      CALL exner_hyb_loc( ijnb_u, ps, p, pks, pk)
     535      else
     536        CALL exner_milieu_loc( ijnb_u, ps, p, pks, pk )
     537      endif
     538
     539!$OMP BARRIER
     540
    544541        unskap=1./kappa
    545 !$OMP DO
     542!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    546543        DO l = 1, llm
    547544            DO j=jjbu,jjeu
    … …  
    551548            ENDDO
    552549        ENDDO
    553         CALL guide_out("SP",jjp1,llm,p,1.)
     550
     551!!$OMP MASTER
     552!     DO l=1,llm,5
     553!         print*,'avant dump2d l=',l,mpi_rank,OMP_GET_THREAD_NUM()
     554!         print*,'avant dump2d l=',l,mpi_rank
     555!         CALL dump2d(iip1,jjnb_u,p(:,l),'ppp   ')
     556!      ENDDO
     557!!$OMP END MASTER
     558!!$OMP BARRIER
     559
     560        CALL guide_out("SP",jjp1,llm,p(ijb_u:ije_u,1:llm),1.)
    554561    ENDIF
    555562   
    556563    if (guide_u) then
    557564        if (guide_add) then
    558 !$OMP DO
     565!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    559566          DO l=1,llm
    560567           f_addu(ijbu:ijeu,l)=(1.-tau)*ugui1(ijbu:ijeu,l)+tau*ugui2(ijbu:ijeu,l)
    561568          ENDDO
    562569        else
    563 !$OMP DO
     570!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    564571          DO l=1,llm
    565572           f_addu(ijbu:ijeu,l)=(1.-tau)*ugui1(ijbu:ijeu,l)+tau*ugui2(ijbu:ijeu,l)-ucov(ijbu:ijeu,l)
    … …  
    575582        IF (f_out) CALL guide_out("u",jjp1,llm,ucov(ijb_u:ije_u,:),factt)
    576583        IF (f_out) CALL guide_out("ucov",jjp1,llm,f_addu(ijb_u:ije_u,:),factt)
    577 !$OMP DO
     584!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    578585        DO l=1,llm
    579586          ucov(ijbu:ijeu,l)=ucov(ijbu:ijeu,l)+f_addu(ijbu:ijeu,l)
    … …  
    584591    if (guide_T) then
    585592        if (guide_add) then
    586 !$OMP DO
     593!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    587594          DO l=1,llm
    588595            f_addu(ijbu:ijeu,l)=(1.-tau)*tgui1(ijbu:ijeu,l)+tau*tgui2(ijbu:ijeu,l)
    589596          ENDDO
    590597        else
    591 !$OMP DO
     598!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    592599          DO l=1,llm
    593600           f_addu(ijbu:ijeu,l)=(1.-tau)*tgui1(ijbu:ijeu,l)+tau*tgui2(ijbu:ijeu,l)-teta(ijbu:ijeu,l)
    … …  
    597604        CALL guide_addfield_u(llm,f_addu,alpha_T)
    598605        IF (f_out) CALL guide_out("teta",jjp1,llm,f_addu(:,:)/factt,factt)
    599 !$OMP DO
     606!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    600607        DO l=1,llm
    601608          teta(ijbu:ijeu,l)=teta(ijbu:ijeu,l)+f_addu(ijbu:ijeu,l)
    … …  
    617624        if (guide_zon) CALL guide_zonave_u(2,1,f_addu(ijb_u:ije_u,1))
    618625        CALL guide_addfield_u(1,f_addu(ijb_u:ije_u,1),alpha_P)
    619         IF (f_out) CALL guide_out("ps",jjp1,1,f_addu(1:ip1jmp1,1)/factt,factt)
     626!       IF (f_out) CALL guide_out("ps",jjp1,1,f_addu(ijb_u:ije_u,1)/factt,factt)
    620627!$OMP MASTER
    621628        ps(ijbu:ijeu)=ps(ijbu:ijeu)+f_addu(ijbu:ijeu,1)
    … …  
    629636    if (guide_Q) then
    630637        if (guide_add) then
    631 !$OMP DO
     638!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    632639          DO l=1,llm
    633640            f_addu(ijbu:ijeu,l)=(1.-tau)*qgui1(ijbu:ijeu,l)+tau*qgui2(ijbu:ijeu,l)
    634641          ENDDO
    635642        else
    636 !$OMP DO
     643!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    637644          DO l=1,llm
    638645            f_addu(ijbu:ijeu,l)=(1.-tau)*qgui1(ijbu:ijeu,l)+tau*qgui2(ijbu:ijeu,l)-q(ijbu:ijeu,l)
    … …  
    643650        IF (f_out) CALL guide_out("q",jjp1,llm,f_addu(:,:)/factt,factt)
    644651
    645 !$OMP DO
     652!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    646653        DO l=1,llm
    647654          q(ijbu:ijeu,l)=q(ijbu:ijeu,l)+f_addu(ijbu:ijeu,l)
    … …  
    651658    if (guide_v) then
    652659        if (guide_add) then
    653 !$OMP DO
     660!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    654661          DO l=1,llm
    655662             f_addv(ijbv:ijev,l)=(1.-tau)*vgui1(ijbv:ijev,l)+tau*vgui2(ijbv:ijev,l)
    … …  
    657664
    658665        else
    659 !$OMP DO
     666!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    660667          DO l=1,llm
    661668            f_addv(ijbv:ijev,l)=(1.-tau)*vgui1(ijbv:ijev,l)+tau*vgui2(ijbv:ijev,l)-vcov(ijbv:ijev,l)
    … …  
    671678        IF (f_out) CALL guide_out("vcov",jjm,llm,f_addv(:,:)/factt,factt)
    672679
    673 !$OMP DO
     680!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    674681        DO l=1,llm
    675682          vcov(ijbv:ijev,l)=vcov(ijbv:ijev,l)+f_addv(ijbv:ijev,l)
    … …  
    695702    INTEGER :: l
    696703
    697 !$OMP DO
     704!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    698705    DO l=1,vsize
    699706      field(ijbu:ijeu,l)=alpha(ijbu:ijeu)*field(ijbu:ijeu,l)*alpha_pcor(l)
    … …  
    718725    INTEGER :: l
    719726
    720 !$OMP DO
     727!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    721728    DO l=1,vsize
    722729      field(ijbv:ijev,l)=alpha(ijbv:ijev)*field(ijbv:ijev,l)*alpha_pcor(l)
    … …  
    771778
    772779   
    773 !$OMP DO
     780!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    774781      DO l=1,vsize
    775782        fieldm(:,l)=0.
    … …  
    841848    ENDIF
    842849
    843 !$OMP DO
     850!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    844851      DO l=1,vsize
    845852      ! Compute zonal average
    … …  
    991998!    ....  Calcul de pls , pression au milieu des couches ,en Pascals
    992999    IF (guide_plevs.EQ.1) THEN
    993 !$OMP DO
     1000!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    9941001        DO l=1,llm
    9951002            DO j=jjbu,jjeu
    … …  
    10081015        unskap=1./kappa
    10091016!$OMP BARRIER
    1010 !$OMP DO
     1017!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    10111018   DO l = 1, llm
    10121019       DO j=jjbu,jjeu
    … …  
    10191026
    10201027!   calcul des pressions pour les grilles u et v
    1021 !$OMP DO
     1028!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    10221029    do l=1,llm
    10231030        do j=jjbu,jjeu
    … …  
    10361043    call massbar_loc(pext, pbarx, pbary )
    10371044!$OMP BARRIER
    1038 !$OMP DO
     1045!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    10391046    do l=1,llm
    10401047        do j=jjbu,jjeu
    … …  
    10451052        enddo
    10461053    enddo
    1047 !$OMP DO
     1054!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    10481055    do l=1,llm
    10491056        do j=jjbv,jjev
    … …  
    11061113!$OMP BARRIER
    11071114        ! Conversion en variables GCM
    1108 !$OMP DO
     1115!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    11091116        do l=1,llm
    11101117            do j=jjbu,jjeu
    … …  
    11761183        ! On suppose qu'on a la bonne variable dans le fichier de guidage:
    11771184        ! Hum.Rel si guide_hr, Hum.Spec. sinon.
    1178 !$OMP DO
     1185!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    11791186        do l=1,llm
    11801187            do j=jjbu,jjeu
    … …  
    12011208        enddo
    12021209        IF (guide_hr) THEN
    1203 !$OMP DO
     1210!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    12041211          do l=1,llm
    12051212            CALL q_sat(iip1*jjnu,teta(:,jjbu:jjeu,l)*pk(:,jjbu:jjeu,l)/cpp,       &
    … …  
    12541261
    12551262        ! Conversion en variables GCM
    1256 !$OMP DO
     1263!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    12571264        do l=1,llm
    12581265            do j=jjbu,jjeu
    … …  
    13291336!$OMP BARRIER
    13301337        ! Conversion en variables GCM
    1331 !$OMP DO
     1338!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    13321339        do l=1,llm
    13331340            do j=jjbv,jjev
    … …  
    20692076
    20702077         IF (invert_y) THEN
     2078 
    20712079!           PRINT*,"Invertion impossible actuellement"
    20722080!           CALL abort_gcm(modname,abort_message,1)
    … …  
    21182126    CHARACTER*(*), INTENT(IN)                      :: varname
    21192127    INTEGER,   INTENT (IN)                         :: hsize,vsize
    2120     REAL, DIMENSION (iip1,hsize,vsize), INTENT(IN) :: field_loc
    2121     REAL, INTENT (IN)                              :: factt
     2128!   REAL, DIMENSION (iip1,hsize,vsize), INTENT(IN) :: field_loc
     2129    REAL, DIMENSION (:,:), INTENT(IN) :: field_loc
     2130    REAL factt
    21222131
    21232132    ! Variables locales
    … …  
    21312140    INTEGER                :: ierr, varid,l
    21322141    REAL zu(ip1jmp1),zv(ip1jm)
    2133     REAL, ALLOCATABLE, DIMENSION(:,:,:) :: field_glo
     2142    REAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: field_glo
    21342143   
    21352144!$OMP MASTER
    2136 
    21372145    ALLOCATE(field_glo(iip1,hsize,vsize))
     2146!$OMP END MASTER
     2147!$OMP BARRIER
     2148
     2149    print*,'gvide_out apres allocation ',hsize,vsize
     2150
    21382151    IF (hsize==jjp1) THEN
    2139        CALL gather_field_u(field_loc,field_glo,vsize)
     2152        CALL gather_field_u(field_loc,field_glo,vsize)
    21402153    ELSE IF (hsize==jjm) THEN
    21412154       CALL gather_field_v(field_loc,field_glo, vsize)
    21422155    ENDIF
    21432156
     2157    print*,'guide_out apres gather '
    21442158    CALL Gather_field_u(alpha_u,zu,1)
    21452159    CALL Gather_field_v(alpha_v,zv,1)
     2160
     2161    IF (mpi_rank >  0) THEN
     2162!$OMP MASTER
     2163       DEALLOCATE(field_glo)
    21462164!$OMP END MASTER
    21472165!$OMP BARRIER
    21482166
    2149     IF (mpi_rank /= 0) RETURN
     2167       RETURN
     2168    ENDIF
    21502169   
    21512170!$OMP MASTER
    2152 !   print *,'Guide: output timestep',timestep,'var ',varname
    21532171    IF (timestep.EQ.0) THEN
    21542172! ----------------------------------------------
    … …  
    22622280    END SELECT
    22632281
     2282!$OMP END MASTER
     2283!$OMP BARRIER
     2284
    22642285    SELECT CASE (varname)
    22652286
    22662287    CASE("u","ua")
    2267         DO l=1,llm ; field_glo(:,2:jjm,l)=field_glo(:,2:jjm,l)/cu(:,2:jjm) ; ENDDO
     2288!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     2289        DO l=1,llm ; print*,'l field-glo',vsize,llm,l ; field_glo(:,2:jjm,l)=field_glo(:,2:jjm,l)/cu(:,2:jjm) ; ENDDO
    22682290        field_glo(:,1,:)=0. ; field_glo(:,jjp1,:)=0.
    22692291    CASE("v","va")
     2292!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    22702293        DO l=1,llm ; field_glo(:,:,l)=field_glo(:,:,l)/cv(:,:) ; ENDDO
    22712294    END SELECT
    … …  
    22752298!    call dump2d(iip1,jjp1,field_glo(:,:,llm),'ua gui1 llm ')
    22762299!    endif
     2300
     2301!$OMP MASTER
     2302
    22772303#ifdef NC_DOUBLE
    22782304    ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field_glo)
    … …  
    22832309    ierr = NF_CLOSE(nid)
    22842310
    2285 
     2311       DEALLOCATE(field_glo)
    22862312!$OMP END MASTER
    22872313!$OMP BARRIER
Note: See TracChangeset for help on using the changeset viewer.