Changeset 1087 for LMDZ4/branches/LMDZ4-dev/libf/dyn3dpar
- Timestamp:
- Feb 3, 2009, 11:00:25 AM (16 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
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.
