Changeset 5246 for LMDZ6/trunk/libf/dyn3d/groupeun.f90
- Timestamp:
- Oct 21, 2024, 2:58:45 PM (23 hours ago)
- File:
-
- 1 moved
-
LMDZ6/trunk/libf/dyn3d/groupeun.f90 (moved) (moved from LMDZ6/trunk/libf/dyn3d/groupeun.F) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/dyn3d/groupeun.f90
r5245 r5246 2 2 ! $Header$ 3 3 ! 4 5 6 7 8 9 10 11 12 13 14 INTEGERjjmax,llmax15 REALq(iip1,jjmax,llmax)16 17 !INTEGER ngroup18 !PARAMETER (ngroup=3)19 20 REALairecn,qn21 REALairecs,qs22 23 INTEGERi,j,l,ig,ig2,j1,j2,i0,jd24 25 c--------------------------------------------------------------------c 26 cStrategie d'optimisation c27 cstocker les valeurs systematiquement recalculees c28 cet identiques d'un pas de temps sur l'autre. Il s'agit des c29 caires des cellules qui sont sommees. S'il n'y a pas de changement c30 cde grille au cours de la simulation tout devrait bien se passer. c31 cAutre optimisation : determination des bornes entre lesquelles "j" c32 cvarie, au lieu de faire un test à chaque fois...33 c--------------------------------------------------------------------c 34 35 INTEGERj_start, j_finish36 37 38 39 40 41 !INTEGER,SAVE :: i_index(iim,ngroup)42 43 !REAL :: qsum(iim/ngroup)44 45 46 47 48 49 50 51 cChamps 3D52 53 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)54 55 56 57 58 59 cConcerne le pole nord60 61 62 63 64 65 !CDIR NODEP66 !CDIR ON_ADB(q)67 68 q(i0,j,l)=q(i0,j,l)+q(i0+offset,j,l)69 70 71 72 73 74 !CDIR NODEP75 !CDIR ON_ADB(q)76 77 78 79 80 81 82 !CDIR ON_ADB(airen_tab)83 !CDIR ON_ADB(q)84 85 86 87 88 89 90 !c Concerne le pole sud91 92 93 94 95 96 !CDIR NODEP97 !CDIR ON_ADB(q)98 99 q(i0,jjp1-j+1-jd,l)= q(i0,jjp1-j+1-jd,l)100 & +q(i0+offset,jjp1-j+1-jd,l)101 102 103 104 105 106 107 !CDIR NODEP108 !CDIR ON_ADB(q)109 110 q(i,jjp1-j+1-jd,l)=q(i-MOD(i-1,2**(ngroup-ig+1)),111 &jjp1-j+1-jd,l)112 113 114 115 116 !CDIR ON_ADB(aires_tab)117 !CDIR ON_ADB(q)118 119 q(i,jjp1-j+1-jd,l)=q(i,jjp1-j+1-jd,l)*120 &aires_tab(i,jjp1-j+1,jd)121 122 123 124 125 126 127 128 129 4 SUBROUTINE groupeun(jjmax,llmax,q) 5 6 USE comconst_mod, ONLY: ngroup 7 8 IMPLICIT NONE 9 10 include "dimensions.h" 11 include "paramet.h" 12 include "comgeom2.h" 13 14 INTEGER :: jjmax,llmax 15 REAL :: q(iip1,jjmax,llmax) 16 17 ! INTEGER ngroup 18 ! PARAMETER (ngroup=3) 19 20 REAL :: airecn,qn 21 REAL :: airecs,qs 22 23 INTEGER :: i,j,l,ig,ig2,j1,j2,i0,jd 24 25 !--------------------------------------------------------------------c 26 ! Strategie d'optimisation c 27 ! stocker les valeurs systematiquement recalculees c 28 ! et identiques d'un pas de temps sur l'autre. Il s'agit des c 29 ! aires des cellules qui sont sommees. S'il n'y a pas de changement c 30 ! de grille au cours de la simulation tout devrait bien se passer. c 31 ! Autre optimisation : determination des bornes entre lesquelles "j" c 32 ! varie, au lieu de faire un test à chaque fois... 33 !--------------------------------------------------------------------c 34 35 INTEGER :: j_start, j_finish 36 37 REAL, SAVE :: airen_tab(iip1,jjp1,0:1) 38 REAL, SAVE :: aires_tab(iip1,jjp1,0:1) 39 40 LOGICAL, SAVE :: first = .TRUE. 41 ! INTEGER,SAVE :: i_index(iim,ngroup) 42 INTEGER :: offset 43 ! REAL :: qsum(iim/ngroup) 44 45 IF (first) THEN 46 CALL INIT_GROUPEUN(airen_tab, aires_tab) 47 first = .FALSE. 48 ENDIF 49 50 51 ! Champs 3D 52 jd=jjp1-jjmax 53 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 54 DO l=1,llm 55 j1=1+jd 56 j2=2 57 DO ig=1,ngroup 58 59 ! Concerne le pole nord 60 j_start = j1-jd 61 j_finish = j2-jd 62 DO ig2=1,ngroup-ig+1 63 offset=2**(ig2-1) 64 DO j=j_start, j_finish 65 !CDIR NODEP 66 !CDIR ON_ADB(q) 67 DO i0=1,iim,2**ig2 68 q(i0,j,l)=q(i0,j,l)+q(i0+offset,j,l) 69 ENDDO 70 ENDDO 71 ENDDO 72 73 DO j=j_start, j_finish 74 !CDIR NODEP 75 !CDIR ON_ADB(q) 76 DO i=1,iim 77 q(i,j,l)=q(i-MOD(i-1,2**(ngroup-ig+1)),j,l) 78 ENDDO 79 ENDDO 80 81 DO j=j_start, j_finish 82 !CDIR ON_ADB(airen_tab) 83 !CDIR ON_ADB(q) 84 DO i=1,iim 85 q(i,j,l)=q(i,j,l)*airen_tab(i,j,jd) 86 ENDDO 87 q(iip1,j,l)=q(1,j,l) 88 ENDDO 89 90 !c Concerne le pole sud 91 j_start = j1-jd 92 j_finish = j2-jd 93 DO ig2=1,ngroup-ig+1 94 offset=2**(ig2-1) 95 DO j=j_start, j_finish 96 !CDIR NODEP 97 !CDIR ON_ADB(q) 98 DO i0=1,iim,2**ig2 99 q(i0,jjp1-j+1-jd,l)= q(i0,jjp1-j+1-jd,l) & 100 +q(i0+offset,jjp1-j+1-jd,l) 101 ENDDO 102 ENDDO 103 ENDDO 104 105 106 DO j=j_start, j_finish 107 !CDIR NODEP 108 !CDIR ON_ADB(q) 109 DO i=1,iim 110 q(i,jjp1-j+1-jd,l)=q(i-MOD(i-1,2**(ngroup-ig+1)), & 111 jjp1-j+1-jd,l) 112 ENDDO 113 ENDDO 114 115 DO j=j_start, j_finish 116 !CDIR ON_ADB(aires_tab) 117 !CDIR ON_ADB(q) 118 DO i=1,iim 119 q(i,jjp1-j+1-jd,l)=q(i,jjp1-j+1-jd,l)* & 120 aires_tab(i,jjp1-j+1,jd) 121 ENDDO 122 q(iip1,jjp1-j+1-jd,l)=q(1,jjp1-j+1-jd,l) 123 ENDDO 124 125 126 j1=j2+1 127 j2=j2+2**ig 128 ENDDO 129 ENDDO 130 130 !$OMP END DO NOWAIT 131 131 132 133 END 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 !INTEGER ngroup149 !PARAMETER (ngroup=3)150 151 REALairen,airecn152 REALaires,airecs153 154 INTEGERi,j,l,ig,j1,j2,i0,jd155 156 INTEGERj_start, j_finish157 158 159 160 161 162 163 164 165 166 !c Concerne le pole nord167 168 169 170 171 172 173 174 175 176 airen_tab(i,j,jd) =177 &aire(i,j) / airen178 179 180 181 182 !c Concerne le pole sud183 184 185 186 187 188 189 190 191 192 aires_tab(i,jjp1-j+1,jd) =193 &aire(i,jjp1-j+1) / aires194 195 196 197 198 199 200 201 202 203 204 END 132 RETURN 133 END SUBROUTINE groupeun 134 135 136 137 138 SUBROUTINE INIT_GROUPEUN(airen_tab, aires_tab) 139 140 USE comconst_mod, ONLY: ngroup 141 142 IMPLICIT NONE 143 144 include "dimensions.h" 145 include "paramet.h" 146 include "comgeom2.h" 147 148 ! INTEGER ngroup 149 ! PARAMETER (ngroup=3) 150 151 REAL :: airen,airecn 152 REAL :: aires,airecs 153 154 INTEGER :: i,j,l,ig,j1,j2,i0,jd 155 156 INTEGER :: j_start, j_finish 157 158 REAL :: airen_tab(iip1,jjp1,0:1) 159 REAL :: aires_tab(iip1,jjp1,0:1) 160 161 DO jd=0, 1 162 j1=1+jd 163 j2=2 164 DO ig=1,ngroup 165 166 ! c Concerne le pole nord 167 j_start = j1-jd 168 j_finish = j2-jd 169 DO j=j_start, j_finish 170 DO i0=1,iim,2**(ngroup-ig+1) 171 airen=0. 172 DO i=i0,i0+2**(ngroup-ig+1)-1 173 airen = airen+aire(i,j) 174 ENDDO 175 DO i=i0,i0+2**(ngroup-ig+1)-1 176 airen_tab(i,j,jd) = & 177 aire(i,j) / airen 178 ENDDO 179 ENDDO 180 ENDDO 181 182 ! c Concerne le pole sud 183 j_start = j1-jd 184 j_finish = j2-jd 185 DO j=j_start, j_finish 186 DO i0=1,iim,2**(ngroup-ig+1) 187 aires=0. 188 DO i=i0,i0+2**(ngroup-ig+1)-1 189 aires=aires+aire(i,jjp1-j+1) 190 ENDDO 191 DO i=i0,i0+2**(ngroup-ig+1)-1 192 aires_tab(i,jjp1-j+1,jd) = & 193 aire(i,jjp1-j+1) / aires 194 ENDDO 195 ENDDO 196 ENDDO 197 198 j1=j2+1 199 j2=j2+2**ig 200 ENDDO 201 ENDDO 202 203 RETURN 204 END SUBROUTINE INIT_GROUPEUN
Note: See TracChangeset
for help on using the changeset viewer.
