- Timestamp:
- Feb 3, 2009, 11:00:25 AM (16 years ago)
- Location:
- LMDZ4/branches/LMDZ4-dev/libf
- Files:
-
- 2 edited
-
dyn3d/groupeun.F (modified) (2 diffs)
-
dyn3dpar/groupeun_p.F (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/branches/LMDZ4-dev/libf/dyn3d/groupeun.F
r524 r1087 2 2 ! $Header$ 3 3 ! 4 subroutinegroupeun(jjmax,llmax,q)5 implicit none4 SUBROUTINE groupeun(jjmax,llmax,q) 5 IMPLICIT NONE 6 6 7 7 #include "dimensions.h" … … 10 10 #include "comgeom2.h" 11 11 12 integerjjmax,llmax13 realq(iip1,jjmax,llmax)12 INTEGER jjmax,llmax 13 REAL q(iip1,jjmax,llmax) 14 14 15 integerngroup16 parameter(ngroup=3)15 INTEGER ngroup 16 PARAMETER (ngroup=3) 17 17 18 real airen,airecn,qn19 real aires,airecs,qs18 REAL airecn,qn 19 REAL airecs,qs 20 20 21 integeri,j,l,ig,j1,j2,i0,jd21 INTEGER i,j,l,ig,j1,j2,i0,jd 22 22 23 Champs 3D 23 c--------------------------------------------------------------------c 24 c Strategie d'optimisation c 25 c stocker les valeurs systematiquement recalculees c 26 c et identiques d'un pas de temps sur l'autre. Il s'agit des c 27 c aires des cellules qui sont sommees. S'il n'y a pas de changement c 28 c de grille au cours de la simulation tout devrait bien se passer. c 29 c Autre optimisation : determination des bornes entre lesquelles "j" c 30 c varie, au lieu de faire un test à chaque fois... 31 c--------------------------------------------------------------------c 32 33 INTEGER j_start, j_finish 34 35 REAL, SAVE :: airen_tab(iip1,jjp1,0:1) 36 REAL, SAVE :: aires_tab(iip1,jjp1,0:1) 37 38 LOGICAL, SAVE :: first = .TRUE. 39 40 IF (first) THEN 41 CALL INIT_GROUPEUN(airen_tab, aires_tab) 42 first = .FALSE. 43 ENDIF 44 45 c Champs 3D 24 46 jd=jjp1-jjmax 25 do l=1,llm26 j1=1+jd27 j2=228 do ig=1,ngroup29 do j=j1-jd,j2-jd30 c print*,'groupe ',ig,' j= ',j,2**(ngroup-ig+1),'pts groupes'31 do i0=1,iim,2**(ngroup-ig+1)32 airen=0.33 airecn=0.34 qn=0.35 aires=0.36 airecs=0.37 qs=0.38 do i=i0,i0+2**(ngroup-ig+1)-139 airen=airen+aire(i,j)40 aires=aires+aire(i,jjp1-j+1)41 qn=qn+q(i,j,l)42 qs=qs+q(i,jjp1-j+1-jd,l)43 enddo44 airecn=0.45 airecs=0.46 do i=i0,i0+2**(ngroup-ig+1)-147 q(i,j,l)=qn*aire(i,j)/airen48 q(i,jjp1-j+1-jd,l)=qs*aire(i,jjp1-j+1)/aires49 enddo50 enddo51 q(iip1,j,l)=q(1,j,l)52 q(iip1,jjp1-j+1-jd,l)=q(1,jjp1-j+1-jd,l)53 enddo54 j1=j2+155 j2=j2+2**ig56 enddo57 enddo58 47 59 return 60 end 48 DO l=1,llm 49 j1=1+jd 50 j2=2 51 DO ig=1,ngroup 52 53 c Concerne le pole nord 54 j_start = j1-jd 55 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 65 ENDDO 66 q(iip1,j,l)=q(1,j,l) 67 ENDDO 68 69 !c Concerne le pole sud 70 j_start = j1-jd 71 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 81 ENDDO 82 q(iip1,jjp1-j+1-jd,l)=q(1,jjp1-j+1-jd,l) 83 ENDDO 84 85 j1=j2+1 86 j2=j2+2**ig 87 ENDDO 88 ENDDO 89 90 RETURN 91 END 92 93 94 95 SUBROUTINE INIT_GROUPEUN(airen_tab, aires_tab) 96 IMPLICIT NONE 97 98 #include "dimensions.h" 99 #include "paramet.h" 100 #include "comconst.h" 101 #include "comgeom2.h" 102 103 INTEGER ngroup 104 PARAMETER (ngroup=3) 105 106 REAL airen,airecn 107 REAL aires,airecs 108 109 INTEGER i,j,l,ig,j1,j2,i0,jd 110 111 INTEGER j_start, j_finish 112 113 REAL :: airen_tab(iip1,jjp1,0:1) 114 REAL :: aires_tab(iip1,jjp1,0:1) 115 116 DO jd=0, 1 117 j1=1+jd 118 j2=2 119 DO ig=1,ngroup 120 121 ! c Concerne le pole nord 122 j_start = j1-jd 123 j_finish = j2-jd 124 DO j=j_start, j_finish 125 DO i0=1,iim,2**(ngroup-ig+1) 126 airen=0. 127 DO i=i0,i0+2**(ngroup-ig+1)-1 128 airen = airen+aire(i,j) 129 ENDDO 130 DO i=i0,i0+2**(ngroup-ig+1)-1 131 airen_tab(i,j,jd) = 132 & aire(i,j) / airen 133 ENDDO 134 ENDDO 135 ENDDO 136 137 ! c Concerne le pole sud 138 j_start = j1-jd 139 j_finish = j2-jd 140 DO j=j_start, j_finish 141 DO i0=1,iim,2**(ngroup-ig+1) 142 aires=0. 143 DO i=i0,i0+2**(ngroup-ig+1)-1 144 aires=aires+aire(i,jjp1-j+1) 145 ENDDO 146 DO i=i0,i0+2**(ngroup-ig+1)-1 147 aires_tab(i,jjp1-j+1,jd) = 148 & aire(i,jjp1-j+1) / aires 149 ENDDO 150 ENDDO 151 ENDDO 152 153 j1=j2+1 154 j2=j2+2**ig 155 ENDDO 156 ENDDO 157 158 RETURN 159 END -
LMDZ4/branches/LMDZ4-dev/libf/dyn3dpar/groupeun_p.F
r764 r1087 1 subroutinegroupeun_p(jjmax,llmax,jjb,jje,q)1 SUBROUTINE groupeun_p(jjmax,llmax,jjb,jje,q) 2 2 USE parallel 3 implicit none3 IMPLICIT NONE 4 4 5 5 #include "dimensions.h" … … 8 8 #include "comgeom2.h" 9 9 10 integerjjmax,llmax,jjb,jje11 realq(iip1,jjmax,llmax)10 INTEGER jjmax,llmax,jjb,jje 11 REAL q(iip1,jjmax,llmax) 12 12 13 integerngroup14 parameter(ngroup=3)13 INTEGER ngroup 14 PARAMETER (ngroup=3) 15 15 16 real airen,airecn,qn17 real aires,airecs,qs16 REAL airecn,qn 17 REAL airecs,qs 18 18 19 integeri,j,l,ig,j1,j2,i0,jd19 INTEGER i,j,l,ig,j1,j2,i0,jd 20 20 21 Champs 3D 21 c--------------------------------------------------------------------c 22 c Strategie d'optimisation c 23 c stocker les valeurs systematiquement recalculees c 24 c et identiques d'un pas de temps sur l'autre. Il s'agit des c 25 c aires des cellules qui sont sommees. S'il n'y a pas de changement c 26 c de grille au cours de la simulation tout devrait bien se passer. c 27 c Autre optimisation : determination des bornes entre lesquelles "j" c 28 c varie, au lieu de faire un test à chaque fois... 29 c--------------------------------------------------------------------c 30 31 INTEGER j_start, j_finish 32 33 REAL, SAVE :: airen_tab(iip1,jjp1,0:1) 34 REAL, SAVE :: aires_tab(iip1,jjp1,0:1) 35 !$OMP THREADPRIVATE(airen_tab, aires_tab) 36 37 LOGICAL, SAVE :: first = .TRUE. 38 !$OMP THREADPRIVATE(first) 39 40 IF (first) THEN 41 CALL INIT_GROUPEUN_P(airen_tab, aires_tab) 42 first = .FALSE. 43 ENDIF 44 45 c Champs 3D 22 46 jd=jjp1-jjmax 23 47 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 24 do l=1,llm 25 j1=1+jd 26 j2=2 27 do ig=1,ngroup 28 do j=j1-jd,j2-jd 29 c print*,'groupe ',ig,' j= ',j,2**(ngroup-ig+1),'pts groupes' 30 if ( j >= jjb .AND. j <= jje) THEN 31 32 do i0=1,iim,2**(ngroup-ig+1) 33 34 airen=0. 35 airecn=0. 36 qn=0. 37 38 do i=i0,i0+2**(ngroup-ig+1)-1 39 airen=airen+aire(i,j) 40 qn=qn+q(i,j,l) 41 enddo 42 airecn=0. 43 do i=i0,i0+2**(ngroup-ig+1)-1 44 q(i,j,l)=qn*aire(i,j)/airen 45 enddo 46 enddo 47 q(iip1,j,l)=q(1,j,l) 48 49 endif 48 DO l=1,llm 49 j1=1+jd 50 j2=2 51 DO ig=1,ngroup 52 53 c Concerne le pole nord 54 j_start = MAX(jjb, j1-jd) 55 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 65 ENDDO 66 q(iip1,j,l)=q(1,j,l) 67 ENDDO 68 69 !c Concerne le pole sud 70 j_start = MAX(1+jjp1-jje-jd, j1-jd) 71 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 81 ENDDO 82 q(iip1,jjp1-j+1-jd,l)=q(1,jjp1-j+1-jd,l) 83 ENDDO 84 85 j1=j2+1 86 j2=j2+2**ig 87 ENDDO 88 ENDDO 89 !$OMP END DO NOWAIT 90 91 RETURN 92 END 93 94 95 96 SUBROUTINE INIT_GROUPEUN_P(airen_tab, aires_tab) 97 98 USE parallel 99 IMPLICIT NONE 100 101 #include "dimensions.h" 102 #include "paramet.h" 103 #include "comconst.h" 104 #include "comgeom2.h" 105 106 INTEGER ngroup 107 PARAMETER (ngroup=3) 108 109 REAL airen,airecn 110 REAL aires,airecs 111 112 INTEGER i,j,l,ig,j1,j2,i0,jd 113 114 INTEGER j_start, j_finish 115 116 REAL :: airen_tab(iip1,jjp1,0:1) 117 REAL :: aires_tab(iip1,jjp1,0:1) 118 119 DO jd=0, 1 120 j1=1+jd 121 j2=2 122 DO ig=1,ngroup 50 123 51 if ( jjp1-j+1-jd >= jjb .AND. jjp1-j+1-jd <= jje) THEN 52 53 do i0=1,iim,2**(ngroup-ig+1) 54 aires=0. 55 airecs=0. 56 qs=0. 57 do i=i0,i0+2**(ngroup-ig+1)-1 58 aires=aires+aire(i,jjp1-j+1) 59 qs=qs+q(i,jjp1-j+1-jd,l) 60 enddo 61 airecs=0. 62 do i=i0,i0+2**(ngroup-ig+1)-1 63 q(i,jjp1-j+1-jd,l)=qs*aire(i,jjp1-j+1)/aires 64 enddo 65 enddo 66 q(iip1,jjp1-j+1-jd,l)=q(1,jjp1-j+1-jd,l) 67 68 endif 69 enddo 70 71 j1=j2+1 72 j2=j2+2**ig 73 enddo 74 enddo 75 c$OMP END DO NOWAIT 76 return 77 end 124 ! c Concerne le pole nord 125 j_start = j1-jd 126 j_finish = j2-jd 127 DO j=j_start, j_finish 128 DO i0=1,iim,2**(ngroup-ig+1) 129 airen=0. 130 DO i=i0,i0+2**(ngroup-ig+1)-1 131 airen = airen+aire(i,j) 132 ENDDO 133 DO i=i0,i0+2**(ngroup-ig+1)-1 134 airen_tab(i,j,jd) = 135 & aire(i,j) / airen 136 ENDDO 137 ENDDO 138 ENDDO 139 140 ! c Concerne le pole sud 141 j_start = j1-jd 142 j_finish = j2-jd 143 DO j=j_start, j_finish 144 DO i0=1,iim,2**(ngroup-ig+1) 145 aires=0. 146 DO i=i0,i0+2**(ngroup-ig+1)-1 147 aires=aires+aire(i,jjp1-j+1) 148 ENDDO 149 DO i=i0,i0+2**(ngroup-ig+1)-1 150 aires_tab(i,jjp1-j+1,jd) = 151 & aire(i,jjp1-j+1) / aires 152 ENDDO 153 ENDDO 154 ENDDO 155 156 j1=j2+1 157 j2=j2+2**ig 158 ENDDO 159 ENDDO 160 161 RETURN 162 END
Note: See TracChangeset
for help on using the changeset viewer.
