Changeset 1279 for LMDZ4/trunk/libf/dyn3dpar/groupeun_p.F
- Timestamp:
- Dec 10, 2009, 10:02:56 AM (15 years ago)
- Location:
- LMDZ4/trunk
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/trunk
- Property svn:mergeinfo changed
/LMDZ4/branches/LMDZ4-dev merged: 1150-1162,1164-1193,1195-1231,1234-1235,1237-1240,1242-1274,1276
- Property svn:mergeinfo changed
-
LMDZ4/trunk/libf/dyn3dpar/groupeun_p.F
r1146 r1279 1 1 SUBROUTINE groupeun_p(jjmax,llmax,jjb,jje,q) 2 2 USE parallel 3 USE Write_Field_p 3 4 IMPLICIT NONE 4 5 … … 17 18 REAL airecs,qs 18 19 19 INTEGER i,j,l,ig, j1,j2,i0,jd20 INTEGER i,j,l,ig,ig2,j1,j2,i0,jd 20 21 21 22 c--------------------------------------------------------------------c … … 37 38 LOGICAL, SAVE :: first = .TRUE. 38 39 !$OMP THREADPRIVATE(first) 40 INTEGER,SAVE :: i_index(iim,ngroup) 41 INTEGER :: offset 42 REAL :: qsum(iim/ngroup) 39 43 40 44 IF (first) THEN … … 54 58 j_start = MAX(jjb, j1-jd) 55 59 j_finish = MIN(jje, j2-jd) 56 DO j=j_start, j_finish 57 DO i0=1,iim,2**(ngroup-ig+1) 58 qn=0. 59 DO i=i0,i0+2**(ngroup-ig+1)-1 60 qn=qn+q(i,j,l) 61 ENDDO 62 DO i=i0,i0+2**(ngroup-ig+1)-1 63 q(i,j,l)=qn*airen_tab(i,j,jd) 64 ENDDO 60 DO ig2=1,ngroup-ig+1 61 offset=2**(ig2-1) 62 DO j=j_start, j_finish 63 !CDIR NODEP 64 !CDIR ON_ADB(q) 65 DO i0=1,iim,2**ig2 66 q(i0,j,l)=q(i0,j,l)+q(i0+offset,j,l) 67 ENDDO 68 ENDDO 69 ENDDO 70 71 DO j=j_start, j_finish 72 !CDIR NODEP 73 !CDIR ON_ADB(q) 74 DO i=1,iim 75 q(i,j,l)=q(i-MOD(i-1,2**(ngroup-ig+1)),j,l) 76 ENDDO 77 ENDDO 78 79 DO j=j_start, j_finish 80 !CDIR ON_ADB(airen_tab) 81 !CDIR ON_ADB(q) 82 DO i=1,iim 83 q(i,j,l)=q(i,j,l)*airen_tab(i,j,jd) 65 84 ENDDO 66 85 q(iip1,j,l)=q(1,j,l) 67 86 ENDDO 68 87 69 88 !c Concerne le pole sud 70 89 j_start = MAX(1+jjp1-jje-jd, j1-jd) 71 90 j_finish = MIN(1+jjp1-jjb-jd, j2-jd) 72 DO j=j_start, j_finish 73 DO i0=1,iim,2**(ngroup-ig+1) 74 qs=0. 75 DO i=i0,i0+2**(ngroup-ig+1)-1 76 qs=qs+q(i,jjp1-j+1-jd,l) 77 ENDDO 78 DO i=i0,i0+2**(ngroup-ig+1)-1 79 q(i,jjp1-j+1-jd,l)=qs*aires_tab(i,jjp1-j+1,jd) 80 ENDDO 91 DO ig2=1,ngroup-ig+1 92 offset=2**(ig2-1) 93 DO j=j_start, j_finish 94 !CDIR NODEP 95 !CDIR ON_ADB(q) 96 DO i0=1,iim,2**ig2 97 q(i0,jjp1-j+1-jd,l)= q(i0,jjp1-j+1-jd,l) 98 & +q(i0+offset,jjp1-j+1-jd,l) 99 ENDDO 100 ENDDO 101 ENDDO 102 103 104 DO j=j_start, j_finish 105 !CDIR NODEP 106 !CDIR ON_ADB(q) 107 DO i=1,iim 108 q(i,jjp1-j+1-jd,l)=q(i-MOD(i-1,2**(ngroup-ig+1)), 109 & jjp1-j+1-jd,l) 110 ENDDO 111 ENDDO 112 113 DO j=j_start, j_finish 114 !CDIR ON_ADB(aires_tab) 115 !CDIR ON_ADB(q) 116 DO i=1,iim 117 q(i,jjp1-j+1-jd,l)=q(i,jjp1-j+1-jd,l)* 118 & aires_tab(i,jjp1-j+1,jd) 81 119 ENDDO 82 120 q(iip1,jjp1-j+1-jd,l)=q(1,jjp1-j+1-jd,l) 83 121 ENDDO 122 84 123 85 124 j1=j2+1
Note: See TracChangeset
for help on using the changeset viewer.