Ignore:
Timestamp:
Sep 20, 2006, 12:12:39 PM (18 years ago)
Author:
Laurent Fairhead
Message:

Nouvelles versions de la dynamique YM
LF

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ4/branches/V3_test/libf/dyn3dpar/vlspltqs_p.F

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