Changeset 1257
- Timestamp:
- Nov 3, 2009, 10:44:11 AM (15 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/branches/LMDZ4-dev/libf/dyn3d/groupeun.F
r1087 r1257 19 19 REAL airecs,qs 20 20 21 INTEGER i,j,l,ig, j1,j2,i0,jd21 INTEGER i,j,l,ig,ig2,j1,j2,i0,jd 22 22 23 23 c--------------------------------------------------------------------c … … 37 37 38 38 LOGICAL, SAVE :: first = .TRUE. 39 INTEGER,SAVE :: i_index(iim,ngroup) 40 INTEGER :: offset 41 REAL :: qsum(iim/ngroup) 39 42 40 43 IF (first) THEN … … 43 46 ENDIF 44 47 48 45 49 c Champs 3D 46 50 jd=jjp1-jjmax 47 51 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 48 52 DO l=1,llm 49 53 j1=1+jd … … 54 58 j_start = j1-jd 55 59 j_finish = 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 = j1-jd 71 90 j_finish = 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 … … 87 126 ENDDO 88 127 ENDDO 128 !$OMP END DO NOWAIT 89 129 90 130 RETURN 91 131 END 92 93 94 132 133 134 135 95 136 SUBROUTINE INIT_GROUPEUN(airen_tab, aires_tab) 96 137 IMPLICIT NONE
Note: See TracChangeset
for help on using the changeset viewer.