Changeset 5105 for LMDZ6/branches/Amaury_dev/libf/dyn3dmem/groupeun_loc.f90
- Timestamp:
- Jul 23, 2024, 7:14:34 PM (4 months ago)
- File:
-
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/groupeun_loc.f90
r5104 r5105 1 2 3 4 5 6 7 8 9 10 11 INTEGERjjmax,llmax,sb,se,jjb,jje12 REALq(iip1,sb:se,llmax)13 14 !INTEGER ngroup15 !PARAMETER (ngroup=3)16 17 REALairecn,qn18 REALairecs,qs19 20 INTEGERi,j,l,ig,ig2,j1,j2,i0,jd21 22 c--------------------------------------------------------------------c 23 cStrategie d'optimisation c24 cstocker les valeurs systematiquement recalculees c25 cet identiques d'un pas de temps sur l'autre. Il s'agit des c26 caires des cellules qui sont sommees. S'il n'y a pas de changement c27 cde grille au cours de la simulation tout devrait bien se passer. c28 cAutre optimisation : determination des bornes entre lesquelles "j" c29 cvarie, au lieu de faire un test a chaque fois...30 c--------------------------------------------------------------------c 31 32 INTEGERj_start, j_finish33 34 35 1 SUBROUTINE groupeun_loc(jjmax,llmax,sb,se,jjb,jje,q) 2 USE parallel_lmdz 3 USE Write_Field_p 4 USE comconst_mod, ONLY: ngroup 5 IMPLICIT NONE 6 7 include "dimensions.h" 8 include "paramet.h" 9 include "comgeom2.h" 10 11 INTEGER :: jjmax,llmax,sb,se,jjb,jje 12 REAL :: q(iip1,sb:se,llmax) 13 14 ! INTEGER ngroup 15 ! PARAMETER (ngroup=3) 16 17 REAL :: airecn,qn 18 REAL :: airecs,qs 19 20 INTEGER :: i,j,l,ig,ig2,j1,j2,i0,jd 21 22 !--------------------------------------------------------------------c 23 ! Strategie d'optimisation c 24 ! stocker les valeurs systematiquement recalculees c 25 ! et identiques d'un pas de temps sur l'autre. Il s'agit des c 26 ! aires des cellules qui sont sommees. S'il n'y a pas de changement c 27 ! de grille au cours de la simulation tout devrait bien se passer. c 28 ! Autre optimisation : determination des bornes entre lesquelles "j" c 29 ! varie, au lieu de faire un test a chaque fois... 30 !--------------------------------------------------------------------c 31 32 INTEGER :: j_start, j_finish 33 34 REAL, SAVE :: airen_tab(iip1,jjp1,0:1) 35 REAL, SAVE :: aires_tab(iip1,jjp1,0:1) 36 36 !$OMP THREADPRIVATE(airen_tab, aires_tab) 37 37 38 38 LOGICAL, SAVE :: first = .TRUE. 39 39 !$OMP THREADPRIVATE(first) 40 !INTEGER,SAVE :: i_index(iim,ngroup)41 42 !REAL :: qsum(iim/ngroup)43 44 45 46 47 48 49 cChamps 3D50 51 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)52 53 54 55 56 57 cConcerne le pole nord58 59 60 61 62 63 !CDIR NODEP64 !CDIR ON_ADB(q)65 66 q(i0,j,l)=q(i0,j,l)+q(i0+offset,j,l)67 68 69 70 71 72 !CDIR NODEP73 !CDIR ON_ADB(q)74 75 76 77 78 79 80 !CDIR ON_ADB(airen_tab)81 !CDIR ON_ADB(q)82 83 84 85 86 87 88 !c Concerne le pole sud89 90 91 92 93 94 !CDIR NODEP95 !CDIR ON_ADB(q)96 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 100 101 102 103 104 105 !CDIR NODEP106 !CDIR ON_ADB(q)107 108 q(i,jjp1-j+1-jd,l)=q(i-MOD(i-1,2**(ngroup-ig+1)),109 &jjp1-j+1-jd,l)110 111 112 113 114 !CDIR ON_ADB(aires_tab)115 !CDIR ON_ADB(q)116 117 q(i,jjp1-j+1-jd,l)=q(i,jjp1-j+1-jd,l)*118 &aires_tab(i,jjp1-j+1,jd)119 120 121 122 123 124 125 126 127 40 ! INTEGER,SAVE :: i_index(iim,ngroup) 41 INTEGER :: offset 42 ! REAL :: qsum(iim/ngroup) 43 44 IF (first) THEN 45 CALL init_groupeun_loc(airen_tab, aires_tab) 46 first = .FALSE. 47 ENDIF 48 49 ! Champs 3D 50 jd=jjp1-jjmax 51 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 52 DO l=1,llm 53 j1=1+jd 54 j2=2 55 DO ig=1,ngroup 56 57 ! Concerne le pole nord 58 j_start = MAX(jjb, j1-jd) 59 j_finish = MIN(jje, j2-jd) 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) 84 ENDDO 85 q(iip1,j,l)=q(1,j,l) 86 ENDDO 87 88 !c Concerne le pole sud 89 j_start = MAX(1+jjp1-jje-jd, j1-jd) 90 j_finish = MIN(1+jjp1-jjb-jd, j2-jd) 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) 119 ENDDO 120 q(iip1,jjp1-j+1-jd,l)=q(1,jjp1-j+1-jd,l) 121 ENDDO 122 123 124 j1=j2+1 125 j2=j2+2**ig 126 ENDDO 127 ENDDO 128 128 !$OMP END DO NOWAIT 129 129 130 RETURN 131 END 132 133 134 135 136 137 138 139 140 141 142 143 144 145 !INTEGER ngroup146 !PARAMETER (ngroup=3)147 148 REALairen,airecn149 REALaires,airecs150 151 INTEGERi,j,l,ig,j1,j2,i0,jd152 153 INTEGERj_start, j_finish154 155 156 157 158 159 160 161 162 163 !c Concerne le pole nord164 165 166 167 168 169 170 171 172 173 airen_tab(i,j,jd) =174 &aire(i,j) / airen175 176 177 178 179 !c Concerne le pole sud180 181 182 183 184 185 186 187 188 189 aires_tab(i,jjp1-j+1,jd) =190 &aire(i,jjp1-j+1) / aires191 192 193 194 195 196 197 198 199 200 RETURN 201 END 130 131 END SUBROUTINE groupeun_loc 132 133 134 135 SUBROUTINE init_groupeun_loc(airen_tab, aires_tab) 136 137 USE parallel_lmdz 138 USE comconst_mod, ONLY: ngroup 139 IMPLICIT NONE 140 141 include "dimensions.h" 142 include "paramet.h" 143 include "comgeom2.h" 144 145 ! INTEGER ngroup 146 ! PARAMETER (ngroup=3) 147 148 REAL :: airen,airecn 149 REAL :: aires,airecs 150 151 INTEGER :: i,j,l,ig,j1,j2,i0,jd 152 153 INTEGER :: j_start, j_finish 154 155 REAL :: airen_tab(iip1,jjp1,0:1) 156 REAL :: aires_tab(iip1,jjp1,0:1) 157 158 DO jd=0, 1 159 j1=1+jd 160 j2=2 161 DO ig=1,ngroup 162 163 ! c Concerne le pole nord 164 j_start = j1-jd 165 j_finish = j2-jd 166 DO j=j_start, j_finish 167 DO i0=1,iim,2**(ngroup-ig+1) 168 airen=0. 169 DO i=i0,i0+2**(ngroup-ig+1)-1 170 airen = airen+aire(i,j) 171 ENDDO 172 DO i=i0,i0+2**(ngroup-ig+1)-1 173 airen_tab(i,j,jd) = & 174 aire(i,j) / airen 175 ENDDO 176 ENDDO 177 ENDDO 178 179 ! c Concerne le pole sud 180 j_start = j1-jd 181 j_finish = j2-jd 182 DO j=j_start, j_finish 183 DO i0=1,iim,2**(ngroup-ig+1) 184 aires=0. 185 DO i=i0,i0+2**(ngroup-ig+1)-1 186 aires=aires+aire(i,jjp1-j+1) 187 ENDDO 188 DO i=i0,i0+2**(ngroup-ig+1)-1 189 aires_tab(i,jjp1-j+1,jd) = & 190 aire(i,jjp1-j+1) / aires 191 ENDDO 192 ENDDO 193 ENDDO 194 195 j1=j2+1 196 j2=j2+2**ig 197 ENDDO 198 ENDDO 199 200 201 END SUBROUTINE init_groupeun_loc
Note: See TracChangeset
for help on using the changeset viewer.
