Changeset 764
- Timestamp:
- Jun 4, 2007, 4:13:10 PM (17 years ago)
- Location:
- LMDZ4/trunk/libf
- Files:
-
- 78 edited
-
dyn3dpar/addfi_p.F (modified) (13 diffs)
-
dyn3dpar/advtrac.h (modified) (2 diffs)
-
dyn3dpar/advtrac_p.F (modified) (21 diffs)
-
dyn3dpar/advx.F (modified) (2 diffs)
-
dyn3dpar/advz.F (modified) (2 diffs)
-
dyn3dpar/bands.F90 (modified) (2 diffs)
-
dyn3dpar/bernoui_p.F (modified) (3 diffs)
-
dyn3dpar/bilan_dyn_p.F (modified) (2 diffs)
-
dyn3dpar/caladvtrac_p.F (modified) (4 diffs)
-
dyn3dpar/caldyn_p.F (modified) (12 diffs)
-
dyn3dpar/calfis_p.F (modified) (43 diffs)
-
dyn3dpar/conf_dat2d.F (modified) (1 diff)
-
dyn3dpar/conf_gcm.F (modified) (1 diff)
-
dyn3dpar/control.h (modified) (1 diff)
-
dyn3dpar/convflu_p.F (modified) (2 diffs)
-
dyn3dpar/convmas_p.F (modified) (2 diffs)
-
dyn3dpar/covcont_p.F (modified) (2 diffs)
-
dyn3dpar/dissip_p.F (modified) (12 diffs)
-
dyn3dpar/diverg_gam_p.F (modified) (2 diffs)
-
dyn3dpar/diverg_p.F (modified) (4 diffs)
-
dyn3dpar/divergf_p.F (modified) (5 diffs)
-
dyn3dpar/divgrad2_p.F (modified) (8 diffs)
-
dyn3dpar/divgrad_p.F (modified) (6 diffs)
-
dyn3dpar/dteta1_p.F (modified) (3 diffs)
-
dyn3dpar/dudv1_p.F (modified) (2 diffs)
-
dyn3dpar/dudv2_p.F (modified) (2 diffs)
-
dyn3dpar/dynredem_p.F (modified) (22 diffs)
-
dyn3dpar/enercin_p.F (modified) (2 diffs)
-
dyn3dpar/exner_hyb_p.F (modified) (1 diff)
-
dyn3dpar/flumass_p.F (modified) (6 diffs)
-
dyn3dpar/fluxstokenc_p.F (modified) (2 diffs)
-
dyn3dpar/fxhyp.F (modified) (4 diffs)
-
dyn3dpar/fyhyp.F (modified) (4 diffs)
-
dyn3dpar/gcm.F (modified) (8 diffs)
-
dyn3dpar/gr_dyn_fi_p.F (modified) (3 diffs)
-
dyn3dpar/gr_fi_dyn_p.F (modified) (2 diffs)
-
dyn3dpar/grad_p.F (modified) (2 diffs)
-
dyn3dpar/gradiv2_p.F (modified) (8 diffs)
-
dyn3dpar/gradiv_p.F (modified) (4 diffs)
-
dyn3dpar/gradsdef.h (modified) (1 diff)
-
dyn3dpar/grid_noro.F (modified) (7 diffs)
-
dyn3dpar/grilles_gcm_netcdf.F (modified) (1 diff)
-
dyn3dpar/groupe_p.F (modified) (7 diffs)
-
dyn3dpar/groupeun_p.F (modified) (2 diffs)
-
dyn3dpar/guide_p.F (modified) (5 diffs)
-
dyn3dpar/iniadvtrac.F (modified) (4 diffs)
-
dyn3dpar/integrd_p.F (modified) (15 diffs)
-
dyn3dpar/laplacien_gam_p.F (modified) (2 diffs)
-
dyn3dpar/laplacien_p.F (modified) (3 diffs)
-
dyn3dpar/laplacien_rot_p.F (modified) (1 diff)
-
dyn3dpar/laplacien_rotgam_p.F (modified) (3 diffs)
-
dyn3dpar/leapfrog_p.F (modified) (50 diffs)
-
dyn3dpar/limx.F (modified) (1 diff)
-
dyn3dpar/limy.F (modified) (1 diff)
-
dyn3dpar/limz.F (modified) (1 diff)
-
dyn3dpar/massbar_p.F (modified) (2 diffs)
-
dyn3dpar/massbarxy_p.F (modified) (2 diffs)
-
dyn3dpar/massdair_p.F (modified) (2 diffs)
-
dyn3dpar/mod_hallo.F90 (modified) (6 diffs)
-
dyn3dpar/nxgrad_gam_p.F (modified) (2 diffs)
-
dyn3dpar/nxgrad_p.F (modified) (2 diffs)
-
dyn3dpar/nxgraro2_p.F (modified) (6 diffs)
-
dyn3dpar/nxgrarot_p.F (modified) (4 diffs)
-
dyn3dpar/parallel.F90 (modified) (17 diffs)
-
dyn3dpar/pentes_ini.F (modified) (1 diff)
-
dyn3dpar/ppm3d.F (modified) (1 diff)
-
dyn3dpar/prather.F (modified) (1 diff)
-
dyn3dpar/pression_p.F (modified) (2 diffs)
-
dyn3dpar/read_reanalyse.F (modified) (10 diffs)
-
dyn3dpar/rotat_nfil_p.F (modified) (2 diffs)
-
dyn3dpar/rotat_p.F (modified) (3 diffs)
-
dyn3dpar/rotatf_p.F (modified) (3 diffs)
-
dyn3dpar/times.F90 (modified) (3 diffs)
-
dyn3dpar/tourpot_p.F (modified) (5 diffs)
-
dyn3dpar/vitvert_p.F (modified) (2 diffs)
-
dyn3dpar/vlsplt_p.F (modified) (32 diffs)
-
dyn3dpar/vlspltqs_p.F (modified) (24 diffs)
-
grid/dimension/makdim (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/trunk/libf/dyn3dpar/addfi_p.F
r630 r764 82 82 ije=ij_end 83 83 84 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 84 85 DO k = 1,llm 85 86 DO j = ijb,ije … … 87 88 ENDDO 88 89 ENDDO 90 c$OMP END DO NOWAIT 89 91 90 92 if (pole_nord) then 93 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 91 94 DO k = 1, llm 92 95 DO ij = 1, iim … … 99 102 ENDDO 100 103 ENDDO 104 c$OMP END DO NOWAIT 101 105 endif 102 106 103 107 if (pole_sud) then 108 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 104 109 DO k = 1, llm 105 110 DO ij = 1, iim … … 112 117 ENDDO 113 118 ENDDO 119 c$OMP END DO NOWAIT 114 120 endif 115 121 c … … 119 125 if (pole_nord) ijb=ij_begin+iip1 120 126 if (pole_sud) ije=ij_end-iip1 121 127 128 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 122 129 DO k = 1,llm 123 130 DO j = ijb,ije … … 125 132 ENDDO 126 133 ENDDO 134 c$OMP END DO NOWAIT 127 135 128 136 if (pole_nord) ijb=ij_begin 129 137 138 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 130 139 DO k = 1,llm 131 140 DO j = ijb,ije … … 133 142 ENDDO 134 143 ENDDO 144 c$OMP END DO NOWAIT 135 145 136 146 c 137 147 if (pole_sud) ije=ij_end 138 148 c$OMP MASTER 139 149 DO j = ijb,ije 140 150 pps(j) = pps(j) + pdpfi(j) * pdt 141 151 ENDDO 142 152 c$OMP END MASTER 143 153 144 154 DO iq = 1, 2 155 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 145 156 DO k = 1,llm 146 157 DO j = ijb,ije … … 149 160 ENDDO 150 161 ENDDO 151 ENDDO 152 162 c$OMP END DO NOWAIT 163 ENDDO 153 164 154 165 DO iq = 3, nq 166 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 155 167 DO k = 1,llm 156 168 DO j = ijb,ije … … 159 171 ENDDO 160 172 ENDDO 161 ENDDO 162 173 c$OMP END DO NOWAIT 174 ENDDO 175 176 c$OMP MASTER 163 177 if (pole_nord) then 164 178 … … 188 202 189 203 endif 204 c$OMP END MASTER 190 205 191 206 if (pole_nord) then 192 207 DO iq = 1, nq 208 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 193 209 DO k = 1, llm 194 210 DO ij = 1, iim … … 201 217 ENDDO 202 218 ENDDO 219 c$OMP END DO NOWAIT 203 220 ENDDO 204 221 endif … … 206 223 if (pole_sud) then 207 224 DO iq = 1, nq 225 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 208 226 DO k = 1, llm 209 227 DO ij = 1, iim … … 216 234 ENDDO 217 235 ENDDO 236 c$OMP END DO NOWAIT 218 237 ENDDO 219 238 endif -
LMDZ4/trunk/libf/dyn3dpar/advtrac.h
r630 r764 5 5 c INCLUDE 'advtrac.h' 6 6 7 COMMON/advtr/iadv,hadv,vadv,tnom,tname,ttext,niadv 7 COMMON/advtr/iadv,hadv,vadv,tnom,tname,ttext,niadv, 8 & nbtrac, nprath, mmt_adj, hadv_flg, vadv_flg, conv_flg, 9 & pbl_flg, tracnam 8 10 INTEGER iadv(nqmx) ! indice schema de transport 9 11 INTEGER hadv(nqmx) ! indice schema transport horizontal … … 13 15 character*10 tname(nqmx) ! nom du traceur pour restart 14 16 character*13 ttext(nqmx) ! nom long du traceur pour sorties 17 18 integer nbtrac 19 integer nprath 20 real mmt_adj(iim+1,jjm+1,llm, 1) 21 integer hadv_flg(nqmx) 22 integer vadv_flg(nqmx) 23 integer conv_flg(nqmx-2) 24 integer pbl_flg(nqmx-2) 25 character*8 tracnam(nqmx-2) 15 26 c----------------------------------------------------------------------- -
LMDZ4/trunk/libf/dyn3dpar/advtrac_p.F
r630 r764 4 4 c 5 5 c 6 #ifdef INCA _CH46 #ifdef INCA 7 7 SUBROUTINE advtrac_p(pbaru,pbarv , 8 8 * p, masse,q,iapptrac,teta, 9 9 * flxw, 10 * pk, 11 * mmt_adj, 12 * hadv_flg) 10 * pk ) 13 11 #else 14 12 SUBROUTINE advtrac_p(pbaru,pbarv , … … 25 23 c 26 24 USE parallel 25 USE Write_Field_p 27 26 USE Bands 28 27 USE mod_hallo … … 56 55 REAL p( ip1jmp1,llmp1 ),teta(ip1jmp1,llm) 57 56 REAL pk(ip1jmp1,llm) 58 #ifdef INCA_CH4 59 cym INTEGER :: hadv_flg(nq) 60 INTEGER :: hadv_flg(nqmx) 61 cym REAL :: mmt_adj(ip1jmp1,llm) 62 REAL :: mmt_adj(ip1jmp1,llm,1) 57 #ifdef INCA 63 58 REAL :: flxw(ip1jmp1,llm) 64 59 #endif … … 70 65 REAL pbaruc(ip1jmp1,llm),pbarvc(ip1jm,llm) 71 66 REAL massem(ip1jmp1,llm),zdp(ip1jmp1) 72 REAL 67 REAL,SAVE::pbarug(ip1jmp1,llm),pbarvg(ip1jm,llm),wg(ip1jmp1,llm) 73 68 REAL (kind=kind(1.d0)) :: t_initial, t_final, tps_cpu 74 69 real cpuadv(nqmx) … … 78 73 INTEGER ij,l,iq,iiq 79 74 REAL zdpmin, zdpmax 80 EXTERNAL minmax81 75 SAVE iadvtr, massem, pbaruc, pbarvc 82 76 DATA iadvtr/0/ 77 c$OMP THREADPRIVATE(iadvtr) 83 78 c---------------------------------------------------------- 84 79 c Rajouts pour PPM … … 98 93 integer ijb,ije,ijb_u,ijb_v,ije_u,ije_v,j 99 94 type(Request) :: Request_vanleer 100 REAL p_tmp( ip1jmp1,llmp1 )101 REAL teta_tmp(ip1jmp1,llm)102 REAL pk_tmp(ip1jmp1,llm)95 REAL,SAVE :: p_tmp( ip1jmp1,llmp1 ) 96 REAL,SAVE :: teta_tmp(ip1jmp1,llm) 97 REAL,SAVE :: pk_tmp(ip1jmp1,llm) 103 98 104 99 ijb_u=ij_begin … … 113 108 c CALL initial0(ijp1llm,pbaruc) 114 109 c CALL initial0(ijmllm,pbarvc) 115 116 pbaruc(ijb_u:ije_u,:)=0. 117 pbarvc(ijb_v:ije_v,:)=0. 118 110 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 111 DO l=1,llm 112 pbaruc(ijb_u:ije_u,l)=0. 113 pbarvc(ijb_v:ije_v,l)=0. 114 ENDDO 115 c$OMP END DO NOWAIT 119 116 ENDIF 120 117 121 118 c accumulation des flux de masse horizontaux 119 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 122 120 DO l=1,llm 123 121 DO ij = ijb_u,ije_u … … 128 126 ENDDO 129 127 ENDDO 128 c$OMP END DO NOWAIT 130 129 131 130 c selection de la masse instantannee des mailles avant le transport. … … 136 135 ije=ij_end 137 136 138 massem(ijb:ije,:)=masse(ijb:ije,:) 137 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 138 DO l=1,llm 139 massem(ijb:ije,l)=masse(ijb:ije,l) 140 ENDDO 141 c$OMP END DO NOWAIT 142 139 143 ccc CALL filtreg ( massem ,jjp1, llm,-2, 2, .TRUE., 1 ) 140 144 c … … 142 146 143 147 iadvtr = iadvtr+1 148 149 c$OMP MASTER 144 150 iapptrac = iadvtr 145 151 c$OMP END MASTER 146 152 147 153 c Test pour savoir si on advecte a ce pas de temps 148 154 149 155 IF ( iadvtr.EQ.iapp_tracvl ) THEN 156 c$OMP MASTER 150 157 call suspend_timer(timer_caldyn) 158 c$OMP END MASTER 151 159 152 160 ijb=ij_begin 153 161 ije=ij_end 154 162 163 164 cc .. Modif P.Le Van ( 20/12/97 ) .... 165 cc 166 167 c traitement des flux de masse avant advection. 168 c 1. calcul de w 169 c 2. groupement des mailles pres du pole. 170 171 c$OMP BARRIER 172 CALL groupe_p( massem, pbaruc,pbarvc, pbarug,pbarvg,wg ) 173 c$OMP BARRIER 174 175 c$OMP BARRIER 176 c$OMP MASTER 155 177 p_tmp(ijb:ije,1:llmp1)=p(ijb:ije,1:llmp1) 156 178 pk_tmp(ijb:ije,1:llm)=pk(ijb:ije,1:llm) 157 179 teta_tmp(ijb:ije,1:llm)=teta(ijb:ije,1:llm) 158 159 160 cc .. Modif P.Le Van ( 20/12/97 ) ....161 cc162 163 c traitement des flux de masse avant advection.164 c 1. calcul de w165 c 2. groupement des mailles pres du pole.166 167 CALL groupe_p( massem, pbaruc,pbarvc, pbarug,pbarvg,wg )168 169 180 call VTb(VTHallo) 170 181 call Register_SwapFieldHallo(pbarug,pbarug,ip1jmp1,llm, … … 195 206 call VTb(VTadvection) 196 207 call start_timer(timer_vanleer) 197 198 199 #ifdef INCA_CH4 208 c$OMP END MASTER 209 c$OMP BARRIER 210 211 #ifdef INCA 200 212 ! ... Flux de masse diaganostiques traceurs 201 213 c flxw = wg / FLOAT(iapp_tracvl) … … 211 223 if (pole_sud) ije=ij_end-iip1 212 224 213 225 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 214 226 DO l=1,llm-1 215 227 DO ij = ijb+1,ije … … 241 253 242 254 ENDDO 255 c$OMP END DO NOWAIT 243 256 244 257 c------------------------------------------------------------------- … … 253 266 cym ----> Revérifier lors de la parallélisation des autres schemas 254 267 255 call massbar_p(massem,massebx,masseby) 256 268 cym call massbar_p(massem,massebx,masseby) 269 270 call vlspltgen_p( q,iadv, 2., massem, wg , 271 * pbarug,pbarvg,dtvr,p_tmp,pk_tmp,teta_tmp ) 272 273 274 GOTO 1234 257 275 c----------------------------------------------------------- 258 276 c Appel des sous programmes d'advection … … 309 327 310 328 call pentes_ini (q(1,1,iq),wg,massem,pbarug,pbarvg,0) 311 #ifdef INCA _CH4329 #ifdef INCA 312 330 do iiq = iq+1, iq+3 313 q(:,:,iiq)=q(:,:,iiq)* mmt_adj(:,:,1)331 q(:,:,iiq)=q(:,:,iiq)*1 314 332 enddo 315 333 #endif … … 328 346 call prather(q(1,1,iq),wg,massem,pbarug,pbarvg, 329 347 s n,dtbon) 330 #ifdef INCA _CH4348 #ifdef INCA 331 349 do iiq = iq+1, iq+9 332 q(:,:,iiq)=q(:,:,iiq)* mmt_adj(:,:,1)350 q(:,:,iiq)=q(:,:,iiq)*1 333 351 enddo 334 352 #endif … … 441 459 end DO 442 460 461 1234 CONTINUE 462 c$OMP BARRIER 463 c$OMP MASTER 443 464 ijb=ij_begin 444 465 ije=ij_end … … 450 471 ENDDO 451 472 473 452 474 CALL qminimum_p( q, 2, finmasse ) 453 475 … … 455 477 c on reinitialise a zero les flux de masse cumules 456 478 c--------------------------------------------------- 457 iadvtr=0479 c iadvtr=0 458 480 call VTe(VTadvection) 459 481 call stop_timer(timer_vanleer) … … 465 487 enddo 466 488 467 #ifdef INCA _CH4489 #ifdef INCA 468 490 call Register_SwapFieldHallo(flxw,flxw,ip1jmp1,llm, 469 491 * jj_nb_caldyn,0,0,Request_vanleer) … … 475 497 call VTe(VThallo) 476 498 call resume_timer(timer_caldyn) 477 499 c$OMP END MASTER 500 c$OMP BARRIER 501 iadvtr=0 478 502 ENDIF ! if iadvtr.EQ.iapp_tracvl 479 503 -
LMDZ4/trunk/libf/dyn3dpar/advx.F
r630 r764 106 106 DO j = 1,jjp1 107 107 DO i = 1,iim 108 sqi = sqi + S0(i,j,l, 9)108 sqi = sqi + S0(i,j,l,ntra) 109 109 ENDDO 110 110 ENDDO … … 483 483 DO j = 1, jjp1 484 484 DO i = 1, iim 485 sqf = sqf + S0(i,j,l, 9)485 sqf = sqf + S0(i,j,l,ntra) 486 486 END DO 487 487 END DO -
LMDZ4/trunk/libf/dyn3dpar/advz.F
r630 r764 105 105 DO j = 1,jjp1 106 106 DO i = 1,iim 107 sqi = sqi + S0(i,j,l, 9)107 sqi = sqi + S0(i,j,l,ntra) 108 108 ENDDO 109 109 ENDDO … … 307 307 DO j = 1,jjp1 308 308 DO i = 1,iim 309 sqf = sqf + S0(i,j,l, 9)309 sqf = sqf + S0(i,j,l,ntra) 310 310 ENDDO 311 311 ENDDO -
LMDZ4/trunk/libf/dyn3dpar/bands.F90
r630 r764 103 103 if (jjphy_para_begin(i)==jjphy_para_end(i-1)) then 104 104 jj_Nb_physic_bis(i)=jj_Nb_physic_bis(i)-1 105 endif 105 else 106 jj_Nb_physic_bis(i-1)=jj_Nb_physic_bis(i-1)+1 107 jj_Nb_physic_bis(i)=jj_Nb_physic_bis(i)-1 108 endif 106 109 endif 107 110 enddo … … 401 404 CLOSE(unit_number) 402 405 else 403 print *,'probl ème lors de l écriture des bandes'406 print *,'probleme lors de l ecriture des bandes' 404 407 endif 405 408 -
LMDZ4/trunk/libf/dyn3dpar/bernoui_p.F
r630 r764 37 37 c 38 38 INTEGER ij,l,ijb,ije,jjb,jje 39 EXTERNAL filtreg_p40 39 c 41 40 c----------------------------------------------------------------------- … … 50 49 jje=jj_end+1 51 50 if (pole_sud) jje=jj_end 52 51 52 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 53 53 DO l=1,llm 54 54 … … 58 58 59 59 ENDDO 60 c$OMP END DO NOWAIT 60 61 c 61 62 c----------------------------------------------------------------------- -
LMDZ4/trunk/libf/dyn3dpar/bilan_dyn_p.F
r630 r764 168 168 c Initialisation 169 169 c===================================================================== 170 ndex3d=0 170 171 if (adjust) return 171 172 … … 342 343 Q(:,jjb:jje,:,iang)=ang(:,jjb:jje,:) 343 344 Q(:,jjb:jje,:,iu)=unat(:,jjb:jje,:) 344 Q(:,jjb:jje,:,iovap)= q(:,jjb:jje,:,1)345 Q(:,jjb:jje,:,iovap)=trac(:,jjb:jje,:,1) 345 346 Q(:,jjb:jje,:,iun)=1. 346 347 -
LMDZ4/trunk/libf/dyn3dpar/caladvtrac_p.F
r630 r764 4 4 c 5 5 c 6 #ifdef INCA _CH46 #ifdef INCA 7 7 SUBROUTINE caladvtrac_p(q,pbaru,pbarv , 8 8 * p ,masse, dq , teta, 9 9 * flxw, 10 10 * pk, 11 * mmt_adj, 12 * hadv_flg,iapptrac) 11 * iapptrac) 13 12 #else 14 13 SUBROUTINE caladvtrac_p(q,pbaru,pbarv , … … 41 40 REAL p( ip1jmp1,llmp1),q( ip1jmp1,llm,nqmx),dq( ip1jmp1,llm,2 ) 42 41 REAL teta( ip1jmp1,llm),pk( ip1jmp1,llm) 43 #ifdef INCA_CH4 44 cym INTEGER :: hadv_flg(nq) 45 INTEGER :: hadv_flg(nqmx) 46 REAL :: mmt_adj(iip1,jjp1,llm) 42 #ifdef INCA 47 43 REAL :: flxw(ip1jmp1,llm) 48 44 #endif … … 58 54 c ------ 59 55 60 EXTERNAL advtrac,minmaxq, qminimum61 56 INTEGER ij,l, iq, iapptrac 62 57 REAL finmasse(ip1jmp1,llm), dtvrtrac … … 77 72 78 73 c advection 74 c print *,'appel a advtrac' 79 75 80 #ifdef INCA _CH476 #ifdef INCA 81 77 CALL advtrac_p( pbaru,pbarv, 82 78 * p, masse,q,iapptrac, teta, 83 79 . flxw, 84 . pk, 85 . mmt_adj, 86 . hadv_flg) 80 . pk) 87 81 #else 88 82 CALL advtrac_p( pbaru,pbarv, -
LMDZ4/trunk/libf/dyn3dpar/caldyn_p.F
r630 r764 46 46 REAL ps(ip1jmp1),phis(ip1jmp1) 47 47 REAL pk(iip1,jjp1,llm),pkf(ip1jmp1,llm) 48 REAL vcont(ip1jm,llm),ucont(ip1jmp1,llm)48 REAL,SAVE :: vcont(ip1jm,llm),ucont(ip1jmp1,llm) 49 49 REAL phi(ip1jmp1,llm),masse(ip1jmp1,llm) 50 50 REAL dv(ip1jm,llm),du(ip1jmp1,llm) 51 51 REAL dteta(ip1jmp1,llm),dp(ip1jmp1) 52 REAL w(ip1jmp1,llm) 52 53 REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm) 53 54 REAL time … … 56 57 c ------ 57 58 58 REAL ang(ip1jmp1,llm),p(ip1jmp1,llmp1) 59 REAL massebx(ip1jmp1,llm),masseby(ip1jm,llm),psexbarxy(ip1jm) 60 REAL vorpot(ip1jm,llm) 61 REAL w(ip1jmp1,llm),ecin(ip1jmp1,llm),convm(ip1jmp1,llm) 62 REAL bern(ip1jmp1,llm) 63 REAL massebxy(ip1jm,llm) 64 65 59 REAL,SAVE :: ang(ip1jmp1,llm) 60 REAL,SAVE :: p(ip1jmp1,llmp1) 61 REAL,SAVE :: massebx(ip1jmp1,llm),masseby(ip1jm,llm) 62 REAL,SAVE :: psexbarxy(ip1jm) 63 REAL,SAVE :: vorpot(ip1jm,llm) 64 REAL,SAVE :: ecin(ip1jmp1,llm) 65 REAL,SAVE :: bern(ip1jmp1,llm) 66 REAL,SAVE :: massebxy(ip1jm,llm) 67 REAL,SAVE :: convm(ip1jmp1,llm) 66 68 INTEGER ij,l,ijb,ije,ierr 67 69 … … 72 74 CALL pression_p ( ip1jmp1, ap , bp , ps , p ) 73 75 cym CALL psextbar ( ps , psexbarxy ) 76 c$OMP BARRIER 74 77 CALL massdair_p ( p , masse ) 75 78 CALL massbar_p ( masse, massebx , masseby ) … … 77 80 CALL flumass_p ( massebx, masseby , vcont, ucont ,pbaru, pbarv ) 78 81 CALL dteta1_p ( teta , pbaru , pbarv, dteta ) 79 CALL convmas_p ( pbaru, pbarv , convm ) 80 82 CALL convmas1_p ( pbaru, pbarv , convm ) 83 c$OMP BARRIER 84 CALL convmas2_p ( convm ) 85 c$OMP BARRIER 81 86 #ifdef DEBUG_IO 87 c$OMP BARRIER 88 c$OMP MASTER 82 89 call WriteField_p('ucont',reshape(ucont,(/iip1,jmp1,llm/))) 83 90 call WriteField_p('vcont',reshape(vcont,(/iip1,jjm,llm/))) … … 91 98 call WriteField_p('dteta',reshape(dteta,(/iip1,jmp1,llm/))) 92 99 call WriteField_p('convm',reshape(convm,(/iip1,jmp1,llm/))) 100 c$OMP END MASTER 101 c$OMP BARRIER 93 102 #endif 94 103 104 c$OMP BARRIER 105 c$OMP MASTER 95 106 ijb=ij_begin 96 107 ije=ij_end … … 99 110 dp( ij ) = convm( ij,1 ) / airesurg( ij ) 100 111 ENDDO 101 112 c$OMP END MASTER 113 c$OMP BARRIER 114 c$OMP FLUSH 102 115 CALL vitvert_p ( convm , w ) 103 116 CALL tourpot_p ( vcov , ucov , massebxy , vorpot ) … … 105 118 106 119 #ifdef DEBUG_IO 120 c$OMP BARRIER 121 c$OMP MASTER 107 122 call WriteField_p('w',reshape(w,(/iip1,jmp1,llm/))) 108 123 call WriteField_p('vorpot',reshape(vorpot,(/iip1,jjm,llm/))) 109 124 call WriteField_p('du',reshape(du,(/iip1,jmp1,llm/))) 110 125 call WriteField_p('dv',reshape(dv,(/iip1,jjm,llm/))) 126 c$OMP END MASTER 127 c$OMP BARRIER 111 128 #endif 112 129 CALL enercin_p ( vcov , ucov , vcont , ucont , ecin ) … … 115 132 116 133 #ifdef DEBUG_IO 134 c$OMP BARRIER 135 c$OMP MASTER 117 136 call WriteField_p('ecin',reshape(ecin,(/iip1,jmp1,llm/))) 118 137 call WriteField_p('bern',reshape(bern,(/iip1,jmp1,llm/))) 119 138 call WriteField_p('du',reshape(du,(/iip1,jmp1,llm/))) 120 139 call WriteField_p('dv',reshape(dv,(/iip1,jjm,llm/))) 140 call WriteField_p('pkf',reshape(pkf,(/iip1,jmp1,llm/))) 141 c$OMP END MASTER 142 c$OMP BARRIER 121 143 #endif 122 144 … … 126 148 if (pole_nord) ijb=ij_begin 127 149 if (pole_sud) ije=ij_end 128 150 151 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 129 152 DO l=1,llm 130 153 DO ij=ijb,ije … … 132 155 ENDDO 133 156 ENDDO 157 c$OMP END DO 134 158 135 136 CALL advect_p( ang, vcov, teta, w, massebx, masseby,du,dv,dteta) 159 CALL advect_new_p(ang,vcov,teta,w,massebx,masseby,du,dv,dteta) 137 160 138 161 C WARNING probleme de peridocite de dv sur les PC/linux. Pb d'arrondi … … 142 165 if (pole_sud) ije=ij_end-iip1 143 166 167 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 144 168 DO l = 1, llm 145 169 DO ij = ijb, ije, iip1 … … 152 176 enddo 153 177 enddo 178 c$OMP END DO NOWAIT 154 179 c----------------------------------------------------------------------- 155 180 c Sorties eventuelles des variables de controle: -
LMDZ4/trunk/libf/dyn3dpar/calfis_p.F
r630 r764 23 23 $ pdq, 24 24 $ pw, 25 #ifdef INCA _CH425 #ifdef INCA 26 26 $ flxw, 27 27 #endif … … 40 40 Use Write_field_p 41 41 USE Times 42 USE IOPHY 42 43 IMPLICIT NONE 43 44 c======================================================================= … … 148 149 149 150 INTEGER i,j,l,ig0,ig,iq,iiq 150 REAL zpsrf(klon) 151 REAL zplev(klon,llm+1),zplay(klon,llm) 152 REAL zphi(klon,llm),zphis(klon) 153 c 154 REAL zufi(klon,llm), zvfi(klon,llm) 155 REAL ztfi(klon,llm),zqfi(klon,llm,nqmx) 156 c 157 REAL pcvgu(klon,llm), pcvgv(klon,llm) 158 REAL pcvgt(klon,llm), pcvgq(klon,llm,2) 159 c 160 REAL pvervel(klon,llm) 161 c 162 REAL zdufi(klon,llm),zdvfi(klon,llm) 163 REAL zdtfi(klon,llm),zdqfi(klon,llm,nqmx) 164 REAL zdpsrf(klon) 165 c 151 REAL,ALLOCATABLE,SAVE :: zpsrf(:) 152 REAL,ALLOCATABLE,SAVE :: zplev(:,:),zplay(:,:) 153 REAL,ALLOCATABLE,SAVE :: zphi(:,:),zphis(:) 154 c 155 REAL,ALLOCATABLE,SAVE :: zufi(:,:), zvfi(:,:) 156 REAL,ALLOCATABLE,SAVE :: ztfi(:,:),zqfi(:,:,:) 157 c 158 REAL,ALLOCATABLE,SAVE :: pcvgu(:,:), pcvgv(:,:) 159 REAL,ALLOCATABLE,SAVE :: pcvgt(:,:), pcvgq(:,:,:) 160 c 161 REAL,ALLOCATABLE,SAVE :: pvervel(:,:) 162 c 163 REAL,ALLOCATABLE,SAVE :: zdufi(:,:),zdvfi(:,:) 164 REAL,ALLOCATABLE,SAVE :: zdtfi(:,:),zdqfi(:,:,:) 165 REAL,ALLOCATABLE,SAVE :: zdpsrf(:) 166 c 167 REAL,ALLOCATABLE,SAVE :: zplev_omp(:,:) 168 REAL,ALLOCATABLE,SAVE :: zplay_omp(:,:) 169 REAL,ALLOCATABLE,SAVE :: zphi_omp(:,:) 170 REAL,ALLOCATABLE,SAVE :: zphis_omp(:) 171 REAL,ALLOCATABLE,SAVE :: presnivs_omp(:) 172 REAL,ALLOCATABLE,SAVE :: zufi_omp(:,:) 173 REAL,ALLOCATABLE,SAVE :: zvfi_omp(:,:) 174 REAL,ALLOCATABLE,SAVE :: ztfi_omp(:,:) 175 REAL,ALLOCATABLE,SAVE :: zqfi_omp(:,:,:) 176 REAL,ALLOCATABLE,SAVE :: pvervel_omp(:,:) 177 REAL,ALLOCATABLE,SAVE :: zdufi_omp(:,:) 178 REAL,ALLOCATABLE,SAVE :: zdvfi_omp(:,:) 179 REAL,ALLOCATABLE,SAVE :: zdtfi_omp(:,:) 180 REAL,ALLOCATABLE,SAVE :: zdqfi_omp(:,:,:) 181 REAL,ALLOCATABLE,SAVE :: zdpsrf_omp(:) 182 183 c$OMP THREADPRIVATE(zplev_omp,zplay_omp,zphi_omp,zphis_omp, 184 c$OMP+ presnivs_omp,zufi_omp,zvfi_omp,ztfi_omp, 185 c$OMP+ zqfi_omp,pvervel_omp,zdufi_omp,zdvfi_omp, 186 c$OMP+ zdtfi_omp,zdqfi_omp,zdpsrf_omp) 187 188 LOGICAL,SAVE :: first_omp=.true. 189 c$OMP THREADPRIVATE(first_omp) 190 166 191 REAL zsin(iim),zcos(iim),z1(iim) 167 192 REAL zsinbis(iim),zcosbis(iim),z1bis(iim) 168 193 REAL unskap, pksurcp 169 170 #ifdef INCA_CH4 194 c 195 cIM diagnostique PVteta, Amip2 196 INTEGER ntetaSTD 197 PARAMETER(ntetaSTD=3) 198 REAL rtetaSTD(ntetaSTD) 199 DATA rtetaSTD/350., 380., 405./ 200 REAL PVteta(klon,ntetaSTD) 201 202 #ifdef INCA 171 203 REAL flxw(iip1,jjp1,llm) 172 204 REAL flxwfi(klon,llm) … … 179 211 DATA firstcal/.true./ 180 212 SAVE firstcal,debut 213 c$OMP THREADPRIVATE(firstcal,debut) 181 214 REAL rdayvrai 182 215 183 REAL, dimension(1:iim,1:llm):: du_send,du_recv,dv_send,dv_recv216 REAL,SAVE,dimension(1:iim,1:llm):: du_send,du_recv,dv_send,dv_recv 184 217 INTEGER :: ierr 185 218 INTEGER,dimension(MPI_STATUS_SIZE,4) :: Status 186 219 INTEGER, dimension(4) :: Req 187 REAL zdufi2(klon+iim,llm),zdvfi2(klon+iim,llm) 188 integer :: k,kstart,kend 220 REAL,ALLOCATABLE,SAVE:: zdufi2(:,:),zdvfi2(:,:) 221 integer :: k,kstart,kend 222 INTEGER :: offset 189 223 c 190 224 c----------------------------------------------------------------------- … … 194 228 c 195 229 230 klon=klon_mpi 231 232 PVteta(:,:)=0. 233 196 234 IF (ngridmx.NE.2+(jjm-1)*iim) THEN 197 235 PRINT*,'STOP dans calfis' … … 209 247 IF ( firstcal ) THEN 210 248 debut = .TRUE. 249 c$OMP MASTER 250 ALLOCATE(zpsrf(klon)) 251 ALLOCATE(zplev(klon,llm+1),zplay(klon,llm)) 252 ALLOCATE(zphi(klon,llm),zphis(klon)) 253 ALLOCATE(zufi(klon,llm), zvfi(klon,llm)) 254 ALLOCATE(ztfi(klon,llm),zqfi(klon,llm,nqmx)) 255 ALLOCATE(pcvgu(klon,llm), pcvgv(klon,llm)) 256 ALLOCATE(pcvgt(klon,llm), pcvgq(klon,llm,2)) 257 ALLOCATE(pvervel(klon,llm)) 258 ALLOCATE(zdufi(klon,llm),zdvfi(klon,llm)) 259 ALLOCATE(zdtfi(klon,llm),zdqfi(klon,llm,nqmx)) 260 ALLOCATE(zdpsrf(klon)) 261 ALLOCATE(zdufi2(klon+iim,llm),zdvfi2(klon+iim,llm)) 262 c$OMP END MASTER 263 c$OMP BARRIER 211 264 ELSE 212 265 debut = .FALSE. … … 222 275 c ---------------------------------- 223 276 277 c$OMP MASTER 224 278 call start_timer(timer_physic) 225 279 c$OMP END MASTER 280 281 c$OMP MASTER 226 282 do ig0=1,klon 227 283 i=Liste_i(ig0) … … 229 285 zpsrf(ig0)=pps(i,j) 230 286 enddo 231 287 c$OMP END MASTER 232 288 233 289 … … 243 299 unskap = 1./ kappa 244 300 c 301 print *,omp_rank,'klon--->',klon 302 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 245 303 DO l = 1, llmp1 246 304 do ig0=1,klon … … 250 308 enddo 251 309 ENDDO 310 c$OMP END DO NOWAIT 252 311 c 253 312 c … … 255 314 c 43. temperature naturelle (en K) et pressions milieux couches . 256 315 c --------------------------------------------------------------- 257 316 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 258 317 DO l=1,llm 259 318 … … 268 327 269 328 ENDDO 329 c$OMP END DO NOWAIT 270 330 271 331 c 43.bis traceurs … … 275 335 DO iq=1,nq 276 336 iiq=niadv(iq) 337 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 277 338 DO l=1,llm 278 339 do ig0=1,klon … … 282 343 enddo 283 344 ENDDO 345 c$OMP END DO NOWAIT 284 346 ENDDO 285 347 … … 287 349 288 350 DO iq=1,2 351 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 289 352 DO l=1,llm 290 353 do ig0=1,klon … … 294 357 enddo 295 358 ENDDO 359 c$OMP END DO NOWAIT 296 360 ENDDO 297 361 … … 302 366 303 367 CALL gr_dyn_fi_p(llm,iip1,jjp1,klon,pphi,zphi) 368 369 c$OMP MASTER 304 370 CALL gr_dyn_fi_p(1,iip1,jjp1,klon,pphis,zphis) 305 371 c$OMP END MASTER 372 c$OMP BARRIER 373 374 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 306 375 DO l=1,llm 307 376 DO ig=1,klon … … 309 378 ENDDO 310 379 ENDDO 311 380 c$OMP END DO NOWAIT 312 381 c .... Calcul de la vitesse verticale ( en Pa*m*s ou Kg/s ) .... 313 382 c 314 383 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 315 384 DO l=1,llm 316 385 do ig0=1,klon … … 322 391 if (pole_sud) pvervel(klon,l)=pw(1,jjp1,l)*g/apols 323 392 ENDDO 324 393 c$OMP END DO NOWAIT 325 394 326 395 c … … 334 403 if (pole_sud) kend=klon-1 335 404 405 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 336 406 DO l=1,llm 337 407 do ig0=kstart,kend … … 351 421 enddo 352 422 ENDDO 353 423 c$OMP END DO NOWAIT 354 424 c 46.champ v: 355 425 c ----------- 356 426 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 357 427 DO l=1,llm 358 428 DO ig0=kstart,kend … … 366 436 ENDDO 367 437 ENDDO 368 438 c$OMP END DO NOWAIT 369 439 370 440 c 47. champs de vents aux pole nord … … 374 444 375 445 if (pole_nord) then 376 446 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 377 447 DO l=1,llm 378 448 … … 397 467 398 468 ENDDO 399 469 c$OMP END DO NOWAIT 400 470 endif 401 471 … … 407 477 408 478 if (pole_sud) then 409 479 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 410 480 DO l=1,llm 411 481 … … 430 500 431 501 ENDDO 432 502 c$OMP END DO NOWAIT 433 503 endif 434 504 435 505 436 #ifdef INCA_CH4 506 IF (monocpu) THEN 507 c 508 cIM calcul PV a teta=350, 380, 405K 509 CALL PVtheta(ngridmx,llm,pucov,pvcov,pteta, 510 $ ztfi,zplay,zplev, 511 $ ntetaSTD,rtetaSTD,PVteta) 512 c 513 ENDIF 514 #ifdef INCA 437 515 CALL gr_dyn_fi_p(llm,iip1,jjp1,klon,flxw,flxwfi) 438 516 #endif … … 443 521 c --------------------- 444 522 445 523 cc$OMP PARALLEL DEFAULT(NONE) 524 cc$OMP+ PRIVATE(i,l,offset,iq) 525 cc$OMP+ SHARED(klon_omp_nb,nq,klon_omp_begin, 526 cc$OMP+ debut,lafin,rdayvrai,heure,dtphys,zplev,zplay, 527 cc$OMP+ zphi,zphis,presnivs,clesphy0,zufi,zvfi,ztfi, 528 cc$OMP+ zqfi,pvervel,zdufi,zdvfi,zdtfi,zdqfi,zdpsrf) 529 530 c PRIVATE(zplev_omp,zplay_omp,zphi_omp,zphis_omp, 531 c c$OMP+ presnivs_omp,zufi_omp,zvfi_omp,ztfi_omp, 532 c c$OMP+ zqfi_omp,pvervel_omp,zdufi_omp,zdvfi_omp, 533 c c$OMP+ zdtfi_omp,zdqfi_omp,zdpsrf_omp) 534 535 c$OMP BARRIER 536 if (first_omp) then 537 klon=klon_omp_nb(omp_rank) 538 539 allocate(zplev_omp(klon,llm+1)) 540 allocate(zplay_omp(klon,llm)) 541 allocate(zphi_omp(klon,llm)) 542 allocate(zphis_omp(klon)) 543 allocate(presnivs_omp(llm)) 544 allocate(zufi_omp(klon,llm)) 545 allocate(zvfi_omp(klon,llm)) 546 allocate(ztfi_omp(klon,llm)) 547 allocate(zqfi_omp(klon,llm,nq)) 548 allocate(pvervel_omp(klon,llm)) 549 allocate(zdufi_omp(klon,llm)) 550 allocate(zdvfi_omp(klon,llm)) 551 allocate(zdtfi_omp(klon,llm)) 552 allocate(zdqfi_omp(klon,llm,nq)) 553 allocate(zdpsrf_omp(klon)) 554 first_omp=.false. 555 endif 556 557 558 klon=klon_omp_nb(omp_rank) 559 offset=klon_omp_begin(omp_rank)-1 560 561 do l=1,llm+1 562 do i=1,klon 563 zplev_omp(i,l)=zplev(offset+i,l) 564 enddo 565 enddo 566 567 do l=1,llm 568 do i=1,klon 569 zplay_omp(i,l)=zplay(offset+i,l) 570 enddo 571 enddo 572 573 do l=1,llm 574 do i=1,klon 575 zphi_omp(i,l)=zphi(offset+i,l) 576 enddo 577 enddo 578 579 580 do i=1,klon 581 zphis_omp(i)=zphis(offset+i) 582 enddo 583 584 585 do l=1,llm 586 presnivs_omp(l)=presnivs(l) 587 enddo 588 589 do l=1,llm 590 do i=1,klon 591 zufi_omp(i,l)=zufi(offset+i,l) 592 enddo 593 enddo 594 595 do l=1,llm 596 do i=1,klon 597 zvfi_omp(i,l)=zvfi(offset+i,l) 598 enddo 599 enddo 600 601 do l=1,llm 602 do i=1,klon 603 ztfi_omp(i,l)=ztfi(offset+i,l) 604 enddo 605 enddo 606 607 do iq=1,nq 608 do l=1,llm 609 do i=1,klon 610 zqfi_omp(i,l,iq)=zqfi(offset+i,l,iq) 611 enddo 612 enddo 613 enddo 614 615 do l=1,llm 616 do i=1,klon 617 pvervel_omp(i,l)=pvervel(offset+i,l) 618 enddo 619 enddo 620 621 do l=1,llm 622 do i=1,klon 623 zdufi_omp(i,l)=zdufi(offset+i,l) 624 enddo 625 enddo 626 627 do l=1,llm 628 do i=1,klon 629 zdvfi_omp(i,l)=zdvfi(offset+i,l) 630 enddo 631 enddo 632 633 do l=1,llm 634 do i=1,klon 635 zdtfi_omp(i,l)=zdtfi(offset+i,l) 636 enddo 637 enddo 638 639 do iq=1,nq 640 do l=1,llm 641 do i=1,klon 642 zdqfi_omp(i,l,iq)=zdqfi(offset+i,l,iq) 643 enddo 644 enddo 645 enddo 646 647 do i=1,klon 648 zdpsrf_omp(i)=zdpsrf(offset+i) 649 enddo 650 651 c$OMP BARRIER 652 cym call WriteField_phy_p('zdtfi_omp',zdtfi_omp(:,:),llm) 653 446 654 CALL physiq (klon, 447 655 . llm, … … 452 660 . heure, 453 661 . dtphys, 454 . zplev ,455 . zplay ,456 . zphi ,457 . zphis ,458 . presnivs ,662 . zplev_omp, 663 . zplay_omp, 664 . zphi_omp, 665 . zphis_omp, 666 . presnivs_omp, 459 667 . clesphy0, 460 . zufi ,461 . zvfi ,462 . ztfi ,463 . zqfi ,464 . pvervel ,465 #ifdef INCA _CH4668 . zufi_omp, 669 . zvfi_omp, 670 . ztfi_omp, 671 . zqfi_omp, 672 . pvervel_omp, 673 #ifdef INCA 466 674 . flxwfi, 467 675 #endif 468 . zdufi, 469 . zdvfi, 470 . zdtfi, 471 . zdqfi, 472 . zdpsrf) 473 676 . zdufi_omp, 677 . zdvfi_omp, 678 . zdtfi_omp, 679 . zdqfi_omp, 680 . zdpsrf_omp, 681 cIM diagnostique PVteta, Amip2 682 . pducov, 683 . PVteta) 684 685 cym call WriteField_phy_p('zdtfi_omp',zdtfi_omp(:,:),llm) 686 687 c$OMP BARRIER 688 689 do l=1,llm+1 690 do i=1,klon 691 zplev(offset+i,l)=zplev_omp(i,l) 692 enddo 693 enddo 694 695 do l=1,llm 696 do i=1,klon 697 zplay(offset+i,l)=zplay_omp(i,l) 698 enddo 699 enddo 700 701 do l=1,llm 702 do i=1,klon 703 zphi(offset+i,l)=zphi_omp(i,l) 704 enddo 705 enddo 706 707 708 do i=1,klon 709 zphis(offset+i)=zphis_omp(i) 710 enddo 711 712 713 do l=1,llm 714 presnivs(l)=presnivs_omp(l) 715 enddo 716 717 do l=1,llm 718 do i=1,klon 719 zufi(offset+i,l)=zufi_omp(i,l) 720 enddo 721 enddo 722 723 do l=1,llm 724 do i=1,klon 725 zvfi(offset+i,l)=zvfi_omp(i,l) 726 enddo 727 enddo 728 729 do l=1,llm 730 do i=1,klon 731 ztfi(offset+i,l)=ztfi_omp(i,l) 732 enddo 733 enddo 734 735 do iq=1,nq 736 do l=1,llm 737 do i=1,klon 738 zqfi(offset+i,l,iq)=zqfi_omp(i,l,iq) 739 enddo 740 enddo 741 enddo 742 743 do l=1,llm 744 do i=1,klon 745 pvervel(offset+i,l)=pvervel_omp(i,l) 746 enddo 747 enddo 748 749 do l=1,llm 750 do i=1,klon 751 zdufi(offset+i,l)=zdufi_omp(i,l) 752 enddo 753 enddo 754 755 do l=1,llm 756 do i=1,klon 757 zdvfi(offset+i,l)=zdvfi_omp(i,l) 758 enddo 759 enddo 760 761 do l=1,llm 762 do i=1,klon 763 zdtfi(offset+i,l)=zdtfi_omp(i,l) 764 enddo 765 enddo 766 767 do iq=1,nq 768 do l=1,llm 769 do i=1,klon 770 zdqfi(offset+i,l,iq)=zdqfi_omp(i,l,iq) 771 enddo 772 enddo 773 enddo 774 775 do i=1,klon 776 zdpsrf(offset+i)=zdpsrf_omp(i) 777 enddo 778 779 780 cc$OMP END PARALLEL 781 klon=klon_mpi 474 782 500 CONTINUE 475 783 c$OMP BARRIER 784 785 c$OMP MASTER 786 cym call WriteField_phy('zdtfi',zdtfi(:,:),llm) 476 787 call stop_timer(timer_physic) 788 c$OMP END MASTER 477 789 478 790 if (MPI_rank>0) then 479 480 du_send(1:iim,1:llm)=zdufi(1:iim,1:llm) 481 dv_send(1:iim,1:llm)=zdvfi(1:iim,1:llm) 482 791 792 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 793 DO l=1,llm 794 du_send(1:iim,l)=zdufi(1:iim,l) 795 dv_send(1:iim,l)=zdvfi(1:iim,l) 796 ENDDO 797 c$OMP END DO NOWAIT 798 799 c$OMP BARRIER 800 c$OMP MASTER 483 801 call MPI_ISSEND(du_send,iim*llm,MPI_REAL8,MPI_Rank-1,401, 484 & MPI_COMM_WORLD,Req(1),ierr)802 & COMM_LMDZ,Req(1),ierr) 485 803 call MPI_ISSEND(dv_send,iim*llm,MPI_REAL8,MPI_Rank-1,402, 486 & MPI_COMM_WORLD,Req(2),ierr) 804 & COMM_LMDZ,Req(2),ierr) 805 c$OMP END MASTER 806 c$OMP BARRIER 487 807 488 808 endif 489 809 490 810 if (MPI_rank<MPI_Size-1) then 491 811 c$OMP BARRIER 812 c$OMP MASTER 492 813 call MPI_IRECV(du_recv,iim*llm,MPI_REAL8,MPI_Rank+1,401, 493 & MPI_COMM_WORLD,Req(3),ierr)814 & COMM_LMDZ,Req(3),ierr) 494 815 call MPI_IRECV(dv_recv,iim*llm,MPI_REAL8,MPI_Rank+1,402, 495 & MPI_COMM_WORLD,Req(4),ierr) 496 816 & COMM_LMDZ,Req(4),ierr) 817 c$OMP END MASTER 818 c$OMP BARRIER 497 819 endif 498 820 821 c$OMP BARRIER 822 c$OMP MASTER 499 823 if (MPI_rank>0 .and. MPI_rank< MPI_Size-1) then 500 824 call MPI_WAITALL(4,Req(1),Status,ierr) … … 504 828 call MPI_WAITALL(2,Req(3),Status,ierr) 505 829 endif 506 507 zdufi2(1:klon,:)=zdufi(1:klon,:) 508 zdufi2(klon+1:klon+iim,:)=du_recv(1:iim,:) 509 510 zdvfi2(1:klon,:)=zdvfi(1:klon,:) 511 zdvfi2(klon+1:klon+iim,:)=dv_recv(1:iim,:) 512 513 pdhfi(:,jjphy_begin,:)=0 514 pdqfi(:,jjphy_begin,:,:)=0 515 pdufi(:,jjphy_begin,:)=0 516 pdvfi(:,jjphy_begin,:)=0 517 pdpsfi(:,jjphy_begin)=0 518 830 c$OMP END MASTER 831 c$OMP BARRIER 832 833 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 834 DO l=1,llm 835 836 zdufi2(1:klon,l)=zdufi(1:klon,l) 837 zdufi2(klon+1:klon+iim,l)=du_recv(1:iim,l) 838 839 zdvfi2(1:klon,l)=zdvfi(1:klon,l) 840 zdvfi2(klon+1:klon+iim,l)=dv_recv(1:iim,l) 841 842 pdhfi(:,jjphy_begin,l)=0 843 pdqfi(:,jjphy_begin,l,:)=0 844 pdufi(:,jjphy_begin,l)=0 845 pdvfi(:,jjphy_begin,l)=0 846 847 if (.not. pole_sud) then 848 pdhfi(:,jjphy_end,l)=0 849 pdqfi(:,jjphy_end,l,:)=0 850 pdufi(:,jjphy_end,l)=0 851 pdvfi(:,jjphy_end,l)=0 852 endif 853 854 ENDDO 855 c$OMP END DO NOWAIT 856 857 c$OMP MASTER 858 pdpsfi(:,jjphy_begin)=0 519 859 if (.not. pole_sud) then 520 pdhfi(:,jjphy_end,:)=0521 pdqfi(:,jjphy_end,:,:)=0522 pdufi(:,jjphy_end,:)=0523 pdvfi(:,jjphy_end,:)=0524 860 pdpsfi(:,jjphy_end)=0 525 861 endif 526 862 c$OMP END MASTER 527 863 c----------------------------------------------------------------------- 528 864 c transformation des tendances physiques en tendances dynamiques: … … 531 867 c tendance sur la pression : 532 868 c ----------------------------------- 533 869 c$OMP MASTER 534 870 CALL gr_fi_dyn_p(1,klon,iip1,jjp1,zdpsrf,pdpsfi) 871 c$OMP END MASTER 535 872 c 536 873 c 62. enthalpie potentielle … … 543 880 if (pole_sud) kend=klon-1 544 881 882 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 545 883 DO l=1,llm 546 884 547 ! cdir NODEP885 !!cdir NODEP 548 886 do ig0=kstart,kend 549 887 i=Liste_i(ig0) … … 565 903 endif 566 904 ENDDO 905 c$OMP END DO NOWAIT 567 906 568 907 c 62. humidite specifique … … 570 909 571 910 DO iq=1,nqmx 911 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 572 912 DO l=1,llm 573 ! cdir NODEP913 !!cdir NODEP 574 914 do ig0=kstart,kend 575 915 i=Liste_i(ig0) … … 592 932 593 933 ENDDO 934 c$OMP END DO NOWAIT 594 935 ENDDO 595 936 … … 597 938 c ------------ 598 939 C initialisation des tendances 599 pdqfi=0. 940 941 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 942 DO l=1,llm 943 pdqfi(:,:,l,:)=0. 944 ENDDO 945 c$OMP END DO NOWAIT 946 600 947 C 601 948 602 949 DO iq=1,nq 603 950 iiq=niadv(iq) 951 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 604 952 DO l=1,llm 605 953 606 ! cdir NODEP954 !!cdir NODEP 607 955 DO ig0=kstart,kend 608 956 i=Liste_i(ig0) … … 625 973 626 974 ENDDO 975 c$OMP END DO NOWAIT 627 976 ENDDO 628 977 629 978 c 65. champ u: 630 979 c ------------ 631 980 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 632 981 DO l=1,llm 633 ! cdir NODEP982 !!cdir NODEP 634 983 do ig0=kstart,kend 635 984 i=Liste_i(ig0) … … 643 992 pdufi(iim,j,l)=0.5*( zdufi2(ig0,l) 644 993 $ + zdufi2(ig0+iim-1,l))*cu(iim,j) 645 994 pdufi(iip1,j,l)=0.5*(zdufi2(ig0,l)+zdufi2(ig0+1,l))*cu(i,j) 646 995 endif 647 996 … … 661 1010 662 1011 ENDDO 663 1012 c$OMP END DO NOWAIT 664 1013 665 1014 c 67. champ v: … … 672 1021 if (pole_sud) kend=klon-1-iim 673 1022 1023 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 674 1024 DO l=1,llm 675 ! cdir NODEP1025 !!cdir NODEP 676 1026 do ig0=kstart,kend 677 1027 i=Liste_i(ig0) … … 684 1034 685 1035 ENDDO 1036 c$OMP END DO NOWAIT 686 1037 687 1038 … … 691 1042 692 1043 if (pole_nord) then 693 1044 1045 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 694 1046 DO l=1,llm 695 1047 … … 705 1057 706 1058 ENDDO 1059 c$OMP END DO NOWAIT 707 1060 708 1061 endif 709 1062 710 1063 if (pole_sud) then 711 712 DO l=1,llm 1064 1065 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1066 DO l=1,llm 713 1067 714 1068 DO i=1,iim … … 723 1077 724 1078 ENDDO 1079 c$OMP END DO NOWAIT 725 1080 726 1081 endif -
LMDZ4/trunk/libf/dyn3dpar/conf_dat2d.F
r630 r764 215 215 ENDDO 216 216 217 deallocate(xtemp) 218 deallocate(ytemp) 219 217 220 RETURN 218 221 END -
LMDZ4/trunk/libf/dyn3dpar/conf_gcm.F
r630 r764 372 372 iflag_con = 2 373 373 CALL getin('iflag_con',iflag_con) 374 ! 375 !Config Key = ip_ebil_dyn 376 !Config Desc = PRINT level for energy conserv. diag. 377 !Config Def = 0 378 !Config Help = PRINT level for energy conservation diag. ; 379 ! les options suivantes existent : 380 !Config 0 pas de print 381 !Config 1 pas de print 382 !Config 2 print, 383 ip_ebil_dyn = 0 384 CALL getin('ip_ebil_dyn',ip_ebil_dyn) 385 ! 374 386 375 387 DO i = 1, longcles -
LMDZ4/trunk/libf/dyn3dpar/control.h
r630 r764 8 8 . iperiod,iapp_tracvl,iconser,iecri,idissip,iphysiq , 9 9 . periodav,ecritphy,iecrimoy,dayref,anneeref, 10 . raz_date,offline 10 . raz_date,offline,ip_ebil_dyn 11 11 12 12 INTEGER nday,day_step,iperiod,iapp_tracvl,iconser,iecri, 13 . idissip,iphysiq,iecrimoy,dayref,anneeref, raz_date 13 . idissip,iphysiq,iecrimoy,dayref,anneeref, raz_date, 14 . ip_ebil_dyn 14 15 REAL periodav, ecritphy 15 16 logical offline -
LMDZ4/trunk/libf/dyn3dpar/convflu_p.F
r630 r764 33 33 c 34 34 35 35 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 36 36 DO 5 l = 1,nbniv 37 37 c … … 80 80 81 81 5 CONTINUE 82 82 c$OMP END DO NOWAIT 83 83 RETURN 84 84 END -
LMDZ4/trunk/libf/dyn3dpar/convmas_p.F
r630 r764 35 35 #include "logic.h" 36 36 37 REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm ),convm( ip1jmp1,llm ) 37 REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm ) 38 REAL, target :: convm( ip1jmp1,llm ) 38 39 INTEGER l,ij 39 40 40 EXTERNAL filtreg_p41 EXTERNAL convflu_p41 INTEGER ijb,ije,jjb,jje 42 42 43 43 INTEGER ijb,ije,jjb,jje44 45 46 47 44 c----------------------------------------------------------------------- 48 45 c .... calcul de - (d(pbaru)/dx + d(pbarv)/dy ) ...... … … 64 61 ije=ij_end+iip1 65 62 if (pole_sud) ije=ij_end 63 66 64 DO l = llmm1, 1, -1 67 65 DO ij = ijb, ije -
LMDZ4/trunk/libf/dyn3dpar/covcont_p.F
r630 r764 42 42 ije_v=ij_end-iip1 43 43 endif 44 44 45 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 45 46 DO 10 l = 1,klevel 46 47 … … 54 55 55 56 10 CONTINUE 57 c$OMP END DO NOWAIT 56 58 RETURN 57 59 END -
LMDZ4/trunk/libf/dyn3dpar/dissip_p.F
r630 r764 49 49 50 50 REAL SSUM 51 EXTERNAL gradiv ,nXgrarot,divgrad,initial052 EXTERNAL gradiv2,nXgraro2,divgrad2,SSUM53 51 integer :: ijb,ije 54 52 c----------------------------------------------------------------------- … … 56 54 c ---------------- 57 55 56 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 58 57 DO l=1,llm 59 58 te1dt(l) = tetaudiv(l) * dtdiss … … 61 60 te3dt(l) = tetah(l) * dtdiss 62 61 ENDDO 62 c$OMP END DO NOWAIT 63 63 c CALL initial0( ijp1llm, du ) 64 64 c CALL initial0( ijmllm , dv ) … … 67 67 ijb=ij_begin 68 68 ije=ij_end 69 70 du(ijb:ije,:)=0 71 dh(ijb:ije,:)=0 69 70 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 71 DO l=1,llm 72 du(ijb:ije,l)=0 73 dh(ijb:ije,l)=0 74 ENDDO 75 c$OMP END DO NOWAIT 72 76 73 77 if (pole_sud) ije=ij_end-iip1 74 75 dv(ijb:ije,:)=0 78 79 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 80 DO l=1,llm 81 dv(ijb:ije,l)=0 82 ENDDO 83 c$OMP END DO NOWAIT 76 84 77 85 c----------------------------------------------------------------------- … … 99 107 if (pole_sud) ije=ij_end-iip1 100 108 109 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 101 110 DO l=1,llm 102 111 if (pole_nord) then … … 123 132 124 133 ENDDO 125 134 c$OMP END DO NOWAIT 126 135 c calcul de la partie n X grad ( rot ): 127 136 c --------------------------------------- … … 142 151 ije=ij_end 143 152 if (pole_sud) ije=ij_end-iip1 144 153 154 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 145 155 DO l=1,llm 146 156 … … 162 172 163 173 ENDDO 174 c$OMP END DO NOWAIT 164 175 165 176 c calcul de la partie div ( grad ): … … 172 183 ijb=ij_begin 173 184 ije=ij_end 174 185 186 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 175 187 DO l = 1, llm 176 188 DO ij = ijb, ije … … 178 190 ENDDO 179 191 ENDDO 180 192 c$OMP END DO NOWAIT 181 193 CALL divgrad2_p( llm,teta, deltapres ,niterh, gdx ) 182 194 ELSE … … 190 202 ije=ij_end 191 203 204 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 192 205 DO l = 1,llm 193 206 DO ij = ijb,ije … … 195 208 ENDDO 196 209 ENDDO 210 c$OMP END DO NOWAIT 197 211 198 212 RETURN -
LMDZ4/trunk/libf/dyn3dpar/diverg_gam_p.F
r630 r764 48 48 if (pole_nord) ijb=ij_begin+iip1 49 49 if(pole_sud) ije=ij_end-iip1 50 50 51 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 51 52 DO 10 l = 1,klevel 52 53 c … … 90 91 endif 91 92 10 CONTINUE 93 c$OMP END DO NOWAIT 92 94 c 93 95 -
LMDZ4/trunk/libf/dyn3dpar/diverg_p.F
r630 r764 46 46 if(pole_sud) ije=ij_end-iip1 47 47 48 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 48 49 DO 10 l = 1,klevel 49 50 c … … 88 89 89 90 10 CONTINUE 91 c$OMP END DO NOWAIT 90 92 c 91 93 … … 93 95 94 96 c 97 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 95 98 DO l = 1, klevel 96 99 DO ij = ijb,ije … … 98 101 ENDDO 99 102 ENDDO 103 c$OMP END DO NOWAIT 100 104 c 101 105 RETURN -
LMDZ4/trunk/libf/dyn3dpar/divergf_p.F
r630 r764 45 45 if (pole_nord) ijb=ij_begin+iip1 46 46 if(pole_sud) ije=ij_end-iip1 47 47 48 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 48 49 DO 10 l = 1,klevel 49 50 c … … 53 54 * cuvsurcv(ij-iim) * y(ij-iim,l) - cuvsurcv(ij+1) * y(ij+1,l) 54 55 ENDDO 56 55 57 c 56 58 c .... correction pour div( 1,j,l) ...... … … 92 94 93 95 10 CONTINUE 96 c$OMP END DO NOWAIT 97 94 98 c 95 99 jjb=jj_begin … … 100 104 101 105 c 106 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 102 107 DO l = 1, klevel 103 108 DO ij = ijb,ije … … 105 110 ENDDO 106 111 ENDDO 112 c$OMP END DO NOWAIT 107 113 c 108 114 RETURN -
LMDZ4/trunk/libf/dyn3dpar/divgrad2_p.F
r630 r764 1 SUBROUTINE divgrad2_p ( klevel, h, deltapres, lh, divgra )1 SUBROUTINE divgrad2_p ( klevel, h, deltapres, lh, divgra_out ) 2 2 c 3 3 c P. Le Van … … 23 23 INTEGER klevel 24 24 REAL h( ip1jmp1,klevel ), deltapres( ip1jmp1,klevel ) 25 REAL divgra( ip1jmp1,klevel) 25 REAL divgra_out( ip1jmp1,klevel) 26 REAL,SAVE :: divgra( ip1jmp1,llm) 27 26 28 c 27 29 c ....... variables locales .......... … … 31 33 c ................................................................... 32 34 33 EXTERNAL filtreg34 EXTERNAL SCOPY, laplacien_gam35 35 INTEGER ijb,ije 36 36 c … … 41 41 ijb=ij_begin 42 42 ije=ij_end 43 divgra(ijb:ije,1:klevel)=h(ijb:ije,1:klevel) 44 43 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 44 DO l = 1, klevel 45 divgra(ijb:ije,l)=h(ijb:ije,l) 46 ENDDO 47 c$OMP END DO NOWAIT 45 48 c 49 c$OMP BARRIER 50 c$OMP MASTER 46 51 call suspend_timer(timer_dissip) 47 52 call exchange_Hallo(divgra,ip1jmp1,llm,1,1) 48 53 call resume_timer(timer_dissip) 54 c$OMP END MASTER 55 c$OMP BARRIER 49 56 CALL laplacien_p( klevel, divgra, divgra ) 50 57 58 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 51 59 DO l = 1, klevel 52 60 DO ij = ijb, ije … … 54 62 ENDDO 55 63 ENDDO 64 c$OMP END DO NOWAIT 65 56 66 c 67 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 57 68 DO l = 1, klevel 58 69 DO ij = ijb, ije … … 60 71 ENDDO 61 72 ENDDO 73 c$OMP END DO NOWAIT 62 74 63 75 c ........ Iteration de l'operateur laplacien_gam ........ 64 76 c 65 77 DO iter = 1, lh - 2 78 c$OMP BARRIER 79 c$OMP MASTER 66 80 call suspend_timer(timer_dissip) 67 81 call exchange_Hallo(divgra,ip1jmp1,llm,1,1) 68 82 call resume_timer(timer_dissip) 83 c$OMP END MASTER 84 c$OMP BARRIER 69 85 CALL laplacien_gam_p ( klevel,cuvscvgam2,cvuscugam2,unsair_gam2, 70 86 * unsapolnga2, unsapolsga2, divgra, divgra ) … … 72 88 c 73 89 c ............................................................... 74 90 91 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 75 92 DO l = 1, klevel 76 93 DO ij = ijb, ije … … 78 95 ENDDO 79 96 ENDDO 97 c$OMP END DO NOWAIT 80 98 c 99 c$OMP BARRIER 100 c$OMP MASTER 81 101 call suspend_timer(timer_dissip) 82 102 call exchange_Hallo(divgra,ip1jmp1,llm,1,1) 83 103 call resume_timer(timer_dissip) 104 c$OMP END MASTER 105 c$OMP BARRIER 106 84 107 CALL laplacien_p ( klevel, divgra, divgra ) 85 108 c 109 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 86 110 DO l = 1,klevel 87 111 DO ij = ijb,ije 88 divgra (ij,l) = nudivgrs * divgra(ij,l) / deltapres(ij,l)112 divgra_out(ij,l) = nudivgrs * divgra(ij,l) / deltapres(ij,l) 89 113 ENDDO 90 114 ENDDO 115 c$OMP END DO NOWAIT 91 116 92 117 RETURN -
LMDZ4/trunk/libf/dyn3dpar/divgrad_p.F
r630 r764 1 SUBROUTINE divgrad_p (klevel,h, lh, divgra )1 SUBROUTINE divgrad_p (klevel,h, lh, divgra_out ) 2 2 USE parallel 3 3 USE times … … 26 26 c 27 27 INTEGER klevel 28 REAL h( ip1jmp1,klevel ), divgra( ip1jmp1,klevel ) 28 REAL h( ip1jmp1,klevel ), divgra_out( ip1jmp1,klevel ) 29 REAL,SAVE :: divgra( ip1jmp1,llm ) 30 29 31 c 30 32 REAL ghy(ip1jm,llm), ghx(ip1jmp1,llm) … … 32 34 INTEGER l,ij,iter,lh 33 35 c 34 EXTERNAL filtreg35 EXTERNAL SCOPY, grad, covcont, diverg36 36 INTEGER ijb,ije,jjb,jje 37 37 c … … 41 41 ijb=ij_begin 42 42 ije=ij_end 43 divgra(ijb:ije,1:klevel)=h(ijb:ije,1:klevel) 44 43 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 44 DO l = 1, klevel 45 divgra(ijb:ije,l)=h(ijb:ije,l) 46 ENDDO 47 c$OMP END DO NOWAIT 45 48 c 46 49 … … 53 56 54 57 c call exchange_Hallo(divgra,ip1jmp1,llm,0,1) 55 58 c$OMP BARRIER 59 c$OMP MASTER 56 60 call suspend_timer(timer_dissip) 57 61 call exchange_Hallo(divgra,ip1jmp1,llm,1,1) 58 62 call resume_timer(timer_dissip) 59 63 c$OMP END MASTER 64 c$OMP BARRIER 60 65 CALL grad_p (klevel,divgra, ghx , ghy ) 61 66 67 c$OMP BARRIER 68 c$OMP MASTER 62 69 call suspend_timer(timer_dissip) 63 70 call exchange_Hallo(ghy,ip1jm,llm,1,0) 64 71 call resume_timer(timer_dissip) 65 72 c$OMP END MASTER 73 c$OMP BARRIER 74 66 75 CALL diverg_p (klevel, ghx , ghy , divgra ) 67 76 … … 70 79 CALL filtreg_p( divgra,jjb,jje,jjp1,klevel,2,1,.true.,1) 71 80 81 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 72 82 DO 5 l = 1,klevel 73 83 DO 4 ij = ijb, ije 74 divgra ( ij,l ) = - cdivh * divgra( ij,l )84 divgra_out( ij,l ) = - cdivh * divgra( ij,l ) 75 85 4 CONTINUE 76 86 5 CONTINUE 87 c$OMP END DO NOWAIT 77 88 c 78 89 10 CONTINUE -
LMDZ4/trunk/libf/dyn3dpar/dteta1_p.F
r630 r764 30 30 REAL hbyv( ip1jm,llm ), hbxu( ip1jmp1,llm ) 31 31 32 EXTERNAL convflu_p33 EXTERNAL filtreg_p34 32 c 35 36 33 INTEGER ijb,ije,jjb,jje 37 34 … … 39 36 jjb=jj_begin 40 37 jje=jj_end 41 38 39 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 42 40 DO 5 l = 1,llm 43 41 … … 73 71 74 72 5 CONTINUE 75 73 c$OMP END DO NOWAIT 76 74 77 75 -
LMDZ4/trunk/libf/dyn3dpar/dudv1_p.F
r630 r764 26 26 c 27 27 28 28 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 29 29 DO 10 l = 1,llm 30 30 c … … 60 60 c 61 61 10 CONTINUE 62 c$OMP END DO NOWAIT 62 63 RETURN 63 64 END -
LMDZ4/trunk/libf/dyn3dpar/dudv2_p.F
r630 r764 32 32 c 33 33 c 34 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 34 35 DO 5 l = 1,llm 35 36 c … … 63 64 c 64 65 5 CONTINUE 66 c$OMP END DO NOWAIT 65 67 c 66 68 RETURN -
LMDZ4/trunk/libf/dyn3dpar/dynredem_p.F
r630 r764 147 147 c 148 148 ierr = NF_REDEF (nid) 149 cIM 220306 BEG 150 #ifdef NC_DOUBLE 151 ierr = NF_DEF_VAR (nid,"controle",NF_DOUBLE,1,idim_index,nvarid) 152 #else 149 153 ierr = NF_DEF_VAR (nid,"controle",NF_FLOAT,1,idim_index,nvarid) 154 #endif 155 cIM 220306 END 150 156 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22, 151 157 . "Parametres de controle") … … 158 164 c 159 165 ierr = NF_REDEF (nid) 166 cIM 220306 BEG 167 #ifdef NC_DOUBLE 168 ierr = NF_DEF_VAR (nid,"rlonu",NF_DOUBLE,1,idim_rlonu,nvarid) 169 #else 160 170 ierr = NF_DEF_VAR (nid,"rlonu",NF_FLOAT,1,idim_rlonu,nvarid) 171 #endif 172 cIM 220306 END 161 173 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23, 162 174 . "Longitudes des points U") … … 169 181 c 170 182 ierr = NF_REDEF (nid) 183 cIM 220306 BEG 184 #ifdef NC_DOUBLE 185 ierr = NF_DEF_VAR (nid,"rlatu",NF_DOUBLE,1,idim_rlatu,nvarid) 186 #else 171 187 ierr = NF_DEF_VAR (nid,"rlatu",NF_FLOAT,1,idim_rlatu,nvarid) 188 #endif 189 cIM 220306 END 172 190 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22, 173 191 . "Latitudes des points U") … … 180 198 c 181 199 ierr = NF_REDEF (nid) 200 cIM 220306 BEG 201 #ifdef NC_DOUBLE 202 ierr = NF_DEF_VAR (nid,"rlonv",NF_DOUBLE,1,idim_rlonv,nvarid) 203 #else 182 204 ierr = NF_DEF_VAR (nid,"rlonv",NF_FLOAT,1,idim_rlonv,nvarid) 205 #endif 206 cIM 220306 END 183 207 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23, 184 208 . "Longitudes des points V") … … 191 215 c 192 216 ierr = NF_REDEF (nid) 217 cIM 220306 BEG 218 #ifdef NC_DOUBLE 219 ierr = NF_DEF_VAR (nid,"rlatv",NF_DOUBLE,1,idim_rlatv,nvarid) 220 #else 193 221 ierr = NF_DEF_VAR (nid,"rlatv",NF_FLOAT,1,idim_rlatv,nvarid) 222 #endif 223 cIM 220306 END 194 224 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22, 195 225 . "Latitudes des points V") … … 202 232 c 203 233 ierr = NF_REDEF (nid) 234 cIM 220306 BEG 235 #ifdef NC_DOUBLE 236 ierr = NF_DEF_VAR (nid,"nivsigs",NF_DOUBLE,1,idim_s,nvarid) 237 #else 204 238 ierr = NF_DEF_VAR (nid,"nivsigs",NF_FLOAT,1,idim_s,nvarid) 239 #endif 240 cIM 220306 END 205 241 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 28, 206 242 . "Numero naturel des couches s") … … 213 249 c 214 250 ierr = NF_REDEF (nid) 251 cIM 220306 BEG 252 #ifdef NC_DOUBLE 253 ierr = NF_DEF_VAR (nid,"nivsig",NF_DOUBLE,1,idim_sig,nvarid) 254 #else 215 255 ierr = NF_DEF_VAR (nid,"nivsig",NF_FLOAT,1,idim_sig,nvarid) 256 #endif 257 cIM 220306 END 216 258 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 32, 217 259 . "Numero naturel des couches sigma") … … 224 266 c 225 267 ierr = NF_REDEF (nid) 268 cIM 220306 BEG 269 #ifdef NC_DOUBLE 270 ierr = NF_DEF_VAR (nid,"ap",NF_DOUBLE,1,idim_sig,nvarid) 271 #else 226 272 ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_sig,nvarid) 273 #endif 274 cIM 220306 END 227 275 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26, 228 276 . "Coefficient A pour hybride") … … 235 283 c 236 284 ierr = NF_REDEF (nid) 285 cIM 220306 BEG 286 #ifdef NC_DOUBLE 287 ierr = NF_DEF_VAR (nid,"bp",NF_DOUBLE,1,idim_sig,nvarid) 288 #else 237 289 ierr = NF_DEF_VAR (nid,"bp",NF_FLOAT,1,idim_sig,nvarid) 290 #endif 291 cIM 220306 END 238 292 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26, 239 293 . "Coefficient B pour hybride") … … 246 300 c 247 301 ierr = NF_REDEF (nid) 302 cIM 220306 BEG 303 #ifdef NC_DOUBLE 304 ierr = NF_DEF_VAR (nid,"presnivs",NF_DOUBLE,1,idim_s,nvarid) 305 #else 248 306 ierr = NF_DEF_VAR (nid,"presnivs",NF_FLOAT,1,idim_s,nvarid) 307 #endif 308 cIM 220306 END 249 309 ierr = NF_ENDDEF(nid) 250 310 #ifdef NC_DOUBLE … … 259 319 dims2(1) = idim_rlonu 260 320 dims2(2) = idim_rlatu 321 cIM 220306 BEG 322 #ifdef NC_DOUBLE 323 ierr = NF_DEF_VAR (nid,"cu",NF_DOUBLE,2,dims2,nvarid) 324 #else 261 325 ierr = NF_DEF_VAR (nid,"cu",NF_FLOAT,2,dims2,nvarid) 326 #endif 327 cIM 220306 END 262 328 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29, 263 329 . "Coefficient de passage pour U") … … 272 338 dims2(1) = idim_rlonv 273 339 dims2(2) = idim_rlatv 340 cIM 220306 BEG 341 #ifdef NC_DOUBLE 342 ierr = NF_DEF_VAR (nid,"cv",NF_DOUBLE,2,dims2,nvarid) 343 #else 274 344 ierr = NF_DEF_VAR (nid,"cv",NF_FLOAT,2,dims2,nvarid) 345 #endif 346 cIM 220306 END 275 347 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29, 276 348 . "Coefficient de passage pour V") … … 287 359 dims2(1) = idim_rlonv 288 360 dims2(2) = idim_rlatu 361 cIM 220306 BEG 362 #ifdef NC_DOUBLE 363 ierr = NF_DEF_VAR (nid,"aire",NF_DOUBLE,2,dims2,nvarid) 364 #else 289 365 ierr = NF_DEF_VAR (nid,"aire",NF_FLOAT,2,dims2,nvarid) 366 #endif 367 cIM 220306 END 290 368 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22, 291 369 . "Aires de chaque maille") … … 302 380 dims2(1) = idim_rlonv 303 381 dims2(2) = idim_rlatu 382 cIM 220306 BEG 383 #ifdef NC_DOUBLE 384 ierr = NF_DEF_VAR (nid,"phisinit",NF_DOUBLE,2,dims2,nvarid) 385 #else 304 386 ierr = NF_DEF_VAR (nid,"phisinit",NF_FLOAT,2,dims2,nvarid) 387 #endif 388 cIM 220306 END 305 389 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19, 306 390 . "Geopotentiel au sol") … … 316 400 ierr = NF_REDEF (nid) ! entrer dans le mode de definition 317 401 c 402 cIM 220306 BEG 403 #ifdef NC_DOUBLE 404 ierr = NF_DEF_VAR (nid,"temps",NF_DOUBLE,1,idim_tim,nvarid) 405 #else 318 406 ierr = NF_DEF_VAR (nid,"temps",NF_FLOAT,1,idim_tim,nvarid) 407 #endif 408 cIM 220306 END 319 409 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19, 320 410 . "Temps de simulation") … … 329 419 dims4(3) = idim_s 330 420 dims4(4) = idim_tim 421 cIM 220306 BEG 422 #ifdef NC_DOUBLE 423 ierr = NF_DEF_VAR (nid,"ucov",NF_DOUBLE,4,dims4,nvarid) 424 #else 331 425 ierr = NF_DEF_VAR (nid,"ucov",NF_FLOAT,4,dims4,nvarid) 426 #endif 427 cIM 220306 END 332 428 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9, 333 429 . "Vitesse U") … … 337 433 dims4(3) = idim_s 338 434 dims4(4) = idim_tim 435 cIM 220306 BEG 436 #ifdef NC_DOUBLE 437 ierr = NF_DEF_VAR (nid,"vcov",NF_DOUBLE,4,dims4,nvarid) 438 #else 339 439 ierr = NF_DEF_VAR (nid,"vcov",NF_FLOAT,4,dims4,nvarid) 440 #endif 441 cIM 220306 END 340 442 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9, 341 443 . "Vitesse V") … … 345 447 dims4(3) = idim_s 346 448 dims4(4) = idim_tim 449 cIM 220306 BEG 450 #ifdef NC_DOUBLE 451 ierr = NF_DEF_VAR (nid,"teta",NF_DOUBLE,4,dims4,nvarid) 452 #else 347 453 ierr = NF_DEF_VAR (nid,"teta",NF_FLOAT,4,dims4,nvarid) 454 #endif 455 cIM 220306 END 348 456 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 11, 349 457 . "Temperature") … … 355 463 IF(nq.GE.1) THEN 356 464 DO iq=1,nq 465 cIM 220306 BEG 466 #ifdef NC_DOUBLE 467 ierr = NF_DEF_VAR (nid,tname(iq),NF_DOUBLE,4,dims4,nvarid) 468 #else 357 469 ierr = NF_DEF_VAR (nid,tname(iq),NF_FLOAT,4,dims4,nvarid) 470 #endif 471 cIM 220306 END 358 472 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,ttext(iq)) 359 473 ENDDO … … 364 478 dims4(3) = idim_s 365 479 dims4(4) = idim_tim 480 cIM 220306 BEG 481 #ifdef NC_DOUBLE 482 ierr = NF_DEF_VAR (nid,"masse",NF_DOUBLE,4,dims4,nvarid) 483 #else 366 484 ierr = NF_DEF_VAR (nid,"masse",NF_FLOAT,4,dims4,nvarid) 485 #endif 486 cIM 220306 END 367 487 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12, 368 488 . "C est quoi ?") … … 371 491 dims3(2) = idim_rlatu 372 492 dims3(3) = idim_tim 493 cIM 220306 BEG 494 #ifdef NC_DOUBLE 495 ierr = NF_DEF_VAR (nid,"ps",NF_DOUBLE,3,dims3,nvarid) 496 #else 373 497 ierr = NF_DEF_VAR (nid,"ps",NF_FLOAT,3,dims3,nvarid) 498 #endif 499 cIM 220306 END 374 500 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 15, 375 501 . "Pression au sol") … … 377 503 ierr = NF_ENDDEF(nid) ! sortir du mode de definition 378 504 ierr = NF_CLOSE(nid) ! fermer le fichier 505 379 506 380 507 PRINT*,'iim,jjm,llm,iday_end',iim,jjm,llm,iday_end -
LMDZ4/trunk/libf/dyn3dpar/enercin_p.F
r630 r764 58 58 c 0.5 * V(i, j)**2 *( alpha2 + alpha3 ) 59 59 60 60 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 61 61 DO 5 l = 1,llm 62 62 … … 117 117 118 118 5 CONTINUE 119 c$OMP END DO NOWAIT 119 120 RETURN 120 121 END -
LMDZ4/trunk/libf/dyn3dpar/exner_hyb_p.F
r630 r764 48 48 REAL xpn, xps 49 49 REAL SSUM 50 EXTERNAL filtreg,SSUM50 EXTERNAL SSUM 51 51 INTEGER ije,ijb,jje,jjb 52 52 c -
LMDZ4/trunk/libf/dyn3dpar/flumass_p.F
r630 r764 37 37 REAL SSUM 38 38 39 39 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 40 40 DO 5 l = 1,llm 41 41 … … 61 61 62 62 5 CONTINUE 63 63 c$OMP END DO NOWAIT 64 64 c ................................................................ 65 65 c calcul de la composante du flux de masse en x aux poles ....... … … 87 87 saireun= SSUM( iim, aireu( 1 ), 1 ) 88 88 89 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 89 90 DO l = 1,llm 90 91 … … 111 112 112 113 ENDDO 113 114 c$OMP END DO NOWAIT 115 114 116 ENDIF 115 117 … … 119 121 saires = SSUM( iim, aire( ip1jm+1 ), 1 ) 120 122 saireus= SSUM( iim, aireu( ip1jm+1 ), 1 ) 121 123 124 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 122 125 DO l = 1,llm 123 126 … … 143 146 144 147 ENDDO 145 148 c$OMP END DO NOWAIT 146 149 ENDIF 147 150 -
LMDZ4/trunk/libf/dyn3dpar/fluxstokenc_p.F
r630 r764 39 39 real tst(1),ist(1),istp(1) 40 40 INTEGER ij,l,irec,i,j,itau 41 INTEGER fluxid, fluxvid,fluxdid41 INTEGER,SAVE :: fluxid, fluxvid,fluxdid 42 42 43 43 SAVE iadvtr, massem,pbaruc,pbarvc,irec … … 49 49 integer :: ijb,ije,jjb,jje,jjn 50 50 type(Request) :: Req 51 52 c AC initialisations 53 cym pbarug(:,:) = 0. 54 cym pbarvg(:,:,:) = 0. 55 cym wg(:,:) = 0. 51 56 52 57 if(first) then -
LMDZ4/trunk/libf/dyn3dpar/fxhyp.F
r630 r764 4 4 c 5 5 c 6 SUBROUTINE fxhyp ( xzoomdeg,grossism,dzoom ,tau ,6 SUBROUTINE fxhyp ( xzoomdeg,grossism,dzooma,tau , 7 7 , rlonm025,xprimm025,rlonv,xprimv,rlonu,xprimu,rlonp025,xprimp025, 8 8 , champmin,champmax ) … … 38 38 c ...... arguments d'entree ....... 39 39 c 40 REAL xzoomdeg,dzoom ,tau,grossism40 REAL xzoomdeg,dzooma,tau,grossism 41 41 42 42 c ...... arguments de sortie ...... … … 47 47 c .... variables locales .... 48 48 c 49 REAL dzoom 49 50 REAL*8 xlon(iip1),xprimm(iip1),xuv 50 51 REAL*8 xtild(0:nmax2) … … 74 75 WRITE(6,*) 'FXHYP scal180,decalx', scal180,decalx 75 76 c 76 IF( dzoom .LT.1.) THEN77 dzoom = dzoom * depi78 ELSEIF( dzoom .LT. 25. ) THEN79 WRITE(6,*) ' Le param. dzoom ypour fxhyp est trop petit ! L aug77 IF( dzooma.LT.1.) THEN 78 dzoom = dzooma * depi 79 ELSEIF( dzooma.LT. 25. ) THEN 80 WRITE(6,*) ' Le param. dzoomx pour fxhyp est trop petit ! L aug 80 81 ,menter et relancer ! ' 81 82 STOP 1 82 83 ELSE 83 dzoom = dzoom * pi/180.84 dzoom = dzooma * pi/180. 84 85 ENDIF 85 86 -
LMDZ4/trunk/libf/dyn3dpar/fyhyp.F
r630 r764 4 4 c 5 5 c 6 SUBROUTINE fyhyp ( yzoomdeg, grossism, dzoom ,tau ,6 SUBROUTINE fyhyp ( yzoomdeg, grossism, dzooma,tau , 7 7 , rrlatu,yyprimu,rrlatv,yyprimv,rlatu2,yprimu2,rlatu1,yprimu1 , 8 8 , champmin,champmax ) … … 37 37 c ....... arguments d'entree ....... 38 38 c 39 REAL yzoomdeg, grossism,dzoom ,tau39 REAL yzoomdeg, grossism,dzooma,tau 40 40 c ( rentres par run.def ) 41 41 … … 49 49 c 50 50 51 REAL dzoom 51 52 REAL*8 ylat(jjp1), yprim(jjp1) 52 53 REAL*8 yuv … … 78 79 y0 = yzoomdeg * pi/180. 79 80 80 IF( dzoom .LT.1.) THEN81 dzoom = dzoom * pi82 ELSEIF( dzoom .LT. 12. ) THEN81 IF( dzooma.LT.1.) THEN 82 dzoom = dzooma * pi 83 ELSEIF( dzooma.LT. 12. ) THEN 83 84 WRITE(6,*) ' Le param. dzoomy pour fyhyp est trop petit ! L aug 84 85 ,menter et relancer ! ' 85 86 STOP 1 86 87 ELSE 87 dzoom = dzoom * pi/180.88 dzoom = dzooma * pi/180. 88 89 ENDIF 89 90 -
LMDZ4/trunk/libf/dyn3dpar/gcm.F
r630 r764 14 14 USE mod_hallo 15 15 USE Bands 16 #ifdef INCA17 USE inca_dim18 #endif19 16 IMPLICIT NONE 20 17 … … 64 61 #include "iniprint.h" 65 62 #include "tracstoke.h" 66 63 #include "advtrac.h" 67 64 68 65 INTEGER longcles … … 119 116 REAL d_h_vcol, d_qt, d_qw, d_ql, d_ec 120 117 CHARACTER*15 ztit 121 INTEGER ip_ebil_dyn ! PRINT level for energy conserv. diag.122 SAVE ip_ebil_dyn123 DATA ip_ebil_dyn/0/124 118 c-jld 125 119 … … 161 155 dynhistave_file = 'dyn_hist_ave' 162 156 157 158 c initialisation Anne 159 hadv_flg(:) = 0. 160 vadv_flg(:) = 0. 161 conv_flg(:) = 0. 162 pbl_flg(:) = 0. 163 tracnam(:) = ' ' 164 nprath = 1 165 nbtrac = 0 166 mmt_adj(:,:,:,:) = 1 167 168 163 169 c-------------------------------------------------------------------------- 164 170 c Iflag_phys controle l'appel a la physique : … … 208 214 call InitDimphy 209 215 call InitBands 216 call MPI_BARRIER(COMM_LMDZ,ierr) 210 217 if (mpi_rank==0) call WriteBands 211 218 call SetDistrib(jj_Nb_Caldyn) … … 218 225 enddo 219 226 call Init_Mod_hallo(MPI_Buffer) 220 227 c$OMP PARALLEL 228 call init_phys_openmp 221 229 call InitComgeomphy 222 230 c$OMP END PARALLEL 223 231 #ifdef INCA 224 call init_inca_dim 232 call init_const_lmdz(nbtrac,anneeref,dayref,iphysiq,day_step,nday) 233 call init_inca_para(iim,jjm+1,klon2,phy_size,klon_para_nb) 225 234 #endif 226 235 … … 251 260 endif 252 261 262 #ifdef INCA 263 call init_inca_dim(klon,llm,iim,jjm, 264 $ rlonu,rlatu,rlonv,rlatv) 265 #endif 253 266 254 267 … … 362 375 WRITE(lunout,*) 363 376 . 'WARNING!!! vitesse verticale nulle dans la physique' 377 364 378 CALL iniphysiq(ngridmx,llm,daysec,day_ini,dtphys , 365 379 , latfi,lonfi,airefi,zcufi,zcvfi,rad,g,r,cpp ) 380 366 381 call_iniphys=.false. 367 382 ENDIF -
LMDZ4/trunk/libf/dyn3dpar/gr_dyn_fi_p.F
r630 r764 1 1 SUBROUTINE gr_dyn_fi_p(nfield,im,jm,ngrid,pdyn,pfi) 2 2 USE dimphy 3 USE PARALLEL 3 4 IMPLICIT NONE 4 5 c======================================================================= … … 14 15 REAL pfi(ngrid,nfield) 15 16 16 INTEGER i,j,ig 17 INTEGER i,j,ig,l 17 18 18 19 c----------------------------------------------------------------------- … … 23 24 c traitement des poles 24 25 c traitement des point normaux 25 26 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 27 DO l=1,nfield 26 28 DO ig=1,klon 27 29 i=Liste_i(ig) 28 30 j=Liste_j(ig) 29 pfi(ig, 1:nfield)=pdyn(i,j,1:nfield)31 pfi(ig,l)=pdyn(i,j,l) 30 32 ENDDO 31 32 33 ENDDO 34 c$OMP END DO NOWAIT 33 35 RETURN 34 36 END -
LMDZ4/trunk/libf/dyn3dpar/gr_fi_dyn_p.F
r630 r764 20 20 c calcul: 21 21 c ------- 22 22 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 23 23 DO ifield=1,nfield 24 24 … … 44 44 45 45 ENDDO 46 46 c$OMP END DO NOWAIT 47 47 RETURN 48 48 END -
LMDZ4/trunk/libf/dyn3dpar/grad_p.F
r630 r764 22 22 c 23 23 c 24 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 24 25 DO 6 l = 1,klevel 25 26 c … … 47 48 c 48 49 6 CONTINUE 50 c$OMP END DO NOWAIT 51 49 52 RETURN 50 53 END -
LMDZ4/trunk/libf/dyn3dpar/gradiv2_p.F
r630 r764 1 SUBROUTINE gradiv2_p(klevel, xcov, ycov, ld, gdx , gdy)1 SUBROUTINE gradiv2_p(klevel, xcov, ycov, ld, gdx_out, gdy_out ) 2 2 c 3 3 c P. Le Van … … 27 27 INTEGER klevel 28 28 REAL xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel ) 29 REAL gdx( ip1jmp1,klevel ), gdy( ip1jm,klevel ) 29 REAL,SAVE :: gdx( ip1jmp1,llm ), gdy( ip1jm,llm ) 30 REAL gdx_out( ip1jmp1,klevel ), gdy_out( ip1jm,klevel ) 30 31 c 31 32 c ........ variables locales ......... 32 33 c 33 REAL div(ip1jmp1,llm)34 REAL,SAVE :: div(ip1jmp1,llm) 34 35 REAL signe, nugrads 35 36 INTEGER l,ij,iter,ld … … 38 39 c ........................................................ 39 40 c 40 EXTERNAL SCOPY, divergf, grad, laplacien_gam, filtreg41 41 c 42 42 c CALL SCOPY( ip1jmp1 * klevel, xcov, 1, gdx, 1 ) … … 45 45 ijb=ij_begin 46 46 ije=ij_end 47 gdx(ijb:ije,1:klevel)=xcov(ijb:ije,1:klevel) 48 47 48 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 49 DO l = 1, klevel 50 gdx(ijb:ije,l)=xcov(ijb:ije,l) 51 ENDDO 52 c$OMP END DO NOWAIT 49 53 50 54 ijb=ij_begin 51 55 ije=ij_end 52 56 if(pole_sud) ije=ij_end-iip1 53 gdy(ijb:ije,1:klevel)=ycov(ijb:ije,1:klevel) 54 57 58 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 59 DO l = 1, klevel 60 gdy(ijb:ije,l)=ycov(ijb:ije,l) 61 ENDDO 62 c$OMP END DO NOWAIT 63 64 c$OMP BARRIER 65 c$OMP MASTER 55 66 call suspend_timer(timer_dissip) 56 67 call exchange_Hallo(gdy,ip1jm,llm,1,0) 57 68 call resume_timer(timer_dissip) 69 c$OMP END MASTER 70 c$OMP BARRIER 58 71 c 59 72 c … … 67 80 68 81 IF( ld.GT.1 ) THEN 69 82 c$OMP BARRIER 83 c$OMP MASTER 70 84 call suspend_timer(timer_dissip) 71 85 call exchange_Hallo(div,ip1jmp1,llm,1,1) 72 86 call resume_timer(timer_dissip) 73 87 c$OMP END MASTER 88 c$OMP BARRIER 74 89 CALL laplacien_p ( klevel, div, div ) 75 90 … … 78 93 79 94 DO iter = 1, ld -2 95 c$OMP BARRIER 96 c$OMP MASTER 80 97 call suspend_timer(timer_dissip) 81 98 call exchange_Hallo(div,ip1jmp1,llm,1,1) 82 99 call resume_timer(timer_dissip) 100 c$OMP END MASTER 101 c$OMP BARRIER 83 102 CALL laplacien_gam ( klevel,cuvscvgam1,cvuscugam1,unsair_gam1, 84 103 * unsapolnga1, unsapolsga1, div, div ) … … 92 111 CALL filtreg_p( div ,jjb,jje, jjp1, klevel, 2, 1, .TRUE., 1 ) 93 112 c call exchange_Hallo(div,ip1jmp1,llm,0,1) 94 113 c$OMP BARRIER 114 c$OMP MASTER 95 115 call suspend_timer(timer_dissip) 96 116 call exchange_Hallo(div,ip1jmp1,llm,1,1) 97 117 call resume_timer(timer_dissip) 98 118 c$OMP END MASTER 119 c$OMP BARRIER 99 120 c call write_field3d_p('div4',reshape(div,(/iip1,jjp1,llm/))) 100 121 CALL grad_p ( klevel, div, gdx, gdy ) … … 104 125 ije=ij_end 105 126 106 127 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 107 128 DO l = 1, klevel 108 129 109 130 if (pole_sud) ije=ij_end 110 131 DO ij = ijb, ije 111 gdx ( ij,l ) = gdx( ij,l ) * nugrads132 gdx_out( ij,l ) = gdx( ij,l ) * nugrads 112 133 ENDDO 113 134 114 135 if (pole_sud) ije=ij_end-iip1 115 136 DO ij = ijb, ije 116 gdy ( ij,l ) = gdy( ij,l ) * nugrads137 gdy_out( ij,l ) = gdy( ij,l ) * nugrads 117 138 ENDDO 118 139 119 140 ENDDO 141 c$OMP END DO NOWAIT 120 142 c 121 143 RETURN -
LMDZ4/trunk/libf/dyn3dpar/gradiv_p.F
r630 r764 1 SUBROUTINE gradiv_p(klevel, xcov, ycov, ld, gdx , gdy)1 SUBROUTINE gradiv_p(klevel, xcov, ycov, ld, gdx_out, gdy_out ) 2 2 c 3 3 c Auteur : P. Le Van … … 26 26 c 27 27 REAL xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel ) 28 REAL gdx( ip1jmp1,klevel ), gdy( ip1jm,klevel)28 REAL,SAVE :: gdx( ip1jmp1,llm ), gdy( ip1jm,llm ) 29 29 30 REAL div(ip1jmp1,llm) 30 REAL gdx_out( ip1jmp1,klevel ), gdy_out( ip1jm,klevel ) 31 32 REAL,SAVE :: div(ip1jmp1,llm) 31 33 32 34 INTEGER l,ij,iter,ld 33 35 c 34 EXTERNAL SCOPY, diverg, grad35 EXTERNAL filtreg36 36 INTEGER ijb,ije,jjb,jje 37 37 c … … 42 42 ijb=ij_begin 43 43 ije=ij_end 44 gdx(ijb:ije,1:klevel)=xcov(ijb:ije,1:klevel)45 44 45 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 46 DO l = 1,klevel 47 gdx(ijb:ije,l)=xcov(ijb:ije,l) 48 ENDDO 49 c$OMP END DO NOWAIT 50 46 51 ijb=ij_begin 47 52 ije=ij_end 48 53 if(pole_sud) ije=ij_end-iip1 49 gdy(ijb:ije,1:klevel)=ycov(ijb:ije,1:klevel) 50 54 55 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 56 DO l = 1,klevel 57 gdy(ijb:ije,l)=ycov(ijb:ije,l) 58 ENDDO 59 c$OMP END DO NOWAIT 60 51 61 c 52 62 DO 10 iter = 1,ld 53 63 64 c$OMP BARRIER 65 c$OMP MASTER 54 66 call suspend_timer(timer_dissip) 55 67 call exchange_Hallo(gdy,ip1jm,llm,1,0) 56 68 call resume_timer(timer_dissip) 57 69 c$OMP END MASTER 70 c$OMP BARRIER 71 58 72 CALL diverg_p( klevel, gdx , gdy, div ) 59 73 … … 63 77 64 78 c call exchange_Hallo(div,ip1jmp1,llm,0,1) 65 79 80 c$OMP BARRIER 81 c$OMP MASTER 66 82 call suspend_timer(timer_dissip) 67 83 call exchange_Hallo(div,ip1jmp1,llm,1,1) 68 84 call resume_timer(timer_dissip) 85 c$OMP END MASTER 86 c$OMP BARRIER 69 87 70 88 CALL grad_p( klevel, div, gdx, gdy ) 71 89 c 90 91 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 72 92 DO 5 l = 1, klevel 73 93 74 94 if(pole_sud) ije=ij_end 75 95 DO 3 ij = ijb, ije 76 gdx ( ij,l ) = - gdx( ij,l ) * cdivu96 gdx_out( ij,l ) = - gdx( ij,l ) * cdivu 77 97 3 CONTINUE 78 98 79 99 if(pole_sud) ije=ij_end-iip1 80 100 DO 4 ij = ijb, ije 81 gdy ( ij,l ) = - gdy( ij,l ) * cdivu101 gdy_out( ij,l ) = - gdy( ij,l ) * cdivu 82 102 4 CONTINUE 83 103 84 104 5 CONTINUE 105 c$OMP END DO NOWAIT 85 106 c 86 107 10 CONTINUE -
LMDZ4/trunk/libf/dyn3dpar/gradsdef.h
r630 r764 3 3 ! 4 4 integer nfmx,imx,jmx,lmx,nvarmx 5 parameter(nfmx=10,imx=200,jmx=150,lmx=20 ,nvarmx=1000)5 parameter(nfmx=10,imx=200,jmx=150,lmx=200,nvarmx=1000) 6 6 7 7 real xd(imx,nfmx),yd(jmx,nfmx),zd(lmx,nfmx),dtime(nfmx) -
LMDZ4/trunk/libf/dyn3dpar/grid_noro.F
r630 r764 53 53 c zval: Minimum altitude 54 54 C======================================================================= 55 55 56 IMPLICIT INTEGER (I,J) 56 57 IMPLICIT REAL(X,Z) … … 79 80 REAL x(imar+1),y(jmar),zphi(imar+1,jmar) 80 81 REAL zmea(imar+1,jmar),zstd(imar+1,jmar) 82 REAL zmea0(imar+1,jmar) ! GK211005 (CG) 81 83 REAL zsig(imar+1,jmar),zgam(imar+1,jmar),zthe(imar+1,jmar) 82 84 REAL zpic(imar+1,jmar),zval(imar+1,jmar) 83 c $$$PB integer mask(imar+1,jmar)85 cxxx PB integer mask(imar+1,jmar) 84 86 real mask(imar+1,jmar), mask_tmp(imar+1,jmar) 85 87 real num_tot(2200,1100),num_lan(2200,1100) … … 272 274 IF (weight(ii,jj) .NE. 0.0) THEN 273 275 c Mask 274 c $$$if(num_lan(ii,jj)/num_tot(ii,jj).ge.0.5)then275 c $$$mask(ii,jj)=1276 c $$$else277 c $$$mask(ii,jj)=0278 c $$$ENDIF276 cXXX if(num_lan(ii,jj)/num_tot(ii,jj).ge.0.5)then 277 cXXX mask(ii,jj)=1 278 cXXX else 279 cXXX mask(ii,jj)=0 280 cXXX ENDIF 279 281 if (.not. masque_lu) then 280 282 mask(ii,jj) = num_lan(ii,jj)/num_tot(ii,jj) … … 309 311 C FIRST FILTER, MOVING AVERAGE OVER 9 POINTS. 310 312 313 zmea0(:,:) = zmea(:,:) ! GK211005 (CG) on sauvegarde la topo non lissee 311 314 CALL MVA9(zmea,iim+1,jjm+1) 312 315 CALL MVA9(zstd,iim+1,jjm+1) … … 316 319 CALL MVA9(zxtzy,iim+1,jjm+1) 317 320 CALL MVA9(zytzy,iim+1,jjm+1) 318 C $$$Masque prenant en compte maximum de terre319 C $$$On seuil a 10% de terre de terre car en dessous les parametres de surface n'on320 C $$$pas de sens (PB)321 CXXX Masque prenant en compte maximum de terre 322 CXXX On seuil a 10% de terre de terre car en dessous les parametres de surface n'on 323 CXXX pas de sens (PB) 321 324 mask_tmp= 0.0 322 325 WHERE(mask .GE. 0.1) mask_tmp = 1. … … 336 339 if(abs(xm).le.xw) xm=xw*sign(1.,xm) 337 340 c slope: 338 c $$$zsig(ii,jj)=sqrt(xq)*mask(ii,jj)339 c $$$c isotropy:340 c $$$zgam(ii,jj)=xp/xq*mask(ii,jj)341 c $$$c angle theta:342 c $$$zthe(ii,jj)=57.29577951*atan2(xm,xl)/2.*mask(ii,jj)343 c $$$zphi(ii,jj)=zmea(ii,jj)*mask(ii,jj)344 c $$$zmea(ii,jj)=zmea(ii,jj)*mask(ii,jj)345 c $$$zpic(ii,jj)=zpic(ii,jj)*mask(ii,jj)346 c $$$zval(ii,jj)=zval(ii,jj)*mask(ii,jj)347 c $$$zstd(ii,jj)=zstd(ii,jj)*mask(ii,jj)348 C $$* PB modif pour maque de terre fractionnaire341 cXXX zsig(ii,jj)=sqrt(xq)*mask(ii,jj) 342 cXXXc isotropy: 343 cXXX zgam(ii,jj)=xp/xq*mask(ii,jj) 344 cXXXc angle theta: 345 cXXX zthe(ii,jj)=57.29577951*atan2(xm,xl)/2.*mask(ii,jj) 346 cXXX zphi(ii,jj)=zmea(ii,jj)*mask(ii,jj) 347 cXXX zmea(ii,jj)=zmea(ii,jj)*mask(ii,jj) 348 cXXX zpic(ii,jj)=zpic(ii,jj)*mask(ii,jj) 349 cXXX zval(ii,jj)=zval(ii,jj)*mask(ii,jj) 350 cXXX zstd(ii,jj)=zstd(ii,jj)*mask(ii,jj) 351 CXX* PB modif pour maque de terre fractionnaire 349 352 c slope: 350 353 zsig(ii,jj)=sqrt(xq)*mask_tmp(ii,jj) … … 353 356 c angle theta: 354 357 zthe(ii,jj)=57.29577951*atan2(xm,xl)/2.*mask_tmp(ii,jj) 355 zphi(ii,jj)=zmea(ii,jj)*mask_tmp(ii,jj) 358 ! GK211005 (CG) ne pas forcement lisser la topo 359 ! zphi(ii,jj)=zmea(ii,jj)*mask_tmp(ii,jj) 360 zphi(ii,jj)=zmea0(ii,jj)*mask_tmp(ii,jj) 361 ! 356 362 zmea(ii,jj)=zmea(ii,jj)*mask_tmp(ii,jj) 357 363 zpic(ii,jj)=zpic(ii,jj)*mask_tmp(ii,jj) -
LMDZ4/trunk/libf/dyn3dpar/grilles_gcm_netcdf.F
r630 r764 73 73 74 74 do i=1,iip1 75 rlonudeg(i)=rlonu(i)*180./pi 76 rlonvdeg(i)=rlonv(i)*180./pi 75 rlonudeg(i)=rlonu(i)*180./pi + 360. 76 rlonvdeg(i)=rlonv(i)*180./pi + 360. 77 77 enddo 78 78 -
LMDZ4/trunk/libf/dyn3dpar/groupe_p.F
r630 r764 30 30 real wm(iip1,jjp1,llm) 31 31 32 real zconvm(iip1,jjp1,llm),zconvmm(iip1,jjp1,llm) 32 real,save :: zconvm(iip1,jjp1,llm) 33 real,save :: zconvmm(iip1,jjp1,llm) 33 34 34 35 real uu … … 38 39 logical firstcall 39 40 save firstcall 41 c$OMP THREADPRIVATE(firstcall) 40 42 41 43 data firstcall/.true./ … … 57 59 jjb=jj_begin 58 60 jje=jj_end 59 zconvmm(:,jjb:jje,:)=zconvm(:,jjb:jje,:) 61 62 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 63 do l=1,llm 64 zconvmm(:,jjb:jje,l)=zconvm(:,jjb:jje,l) 65 enddo 66 c$OMP END DO NOWAIT 67 60 68 call groupeun_p(jjp1,llm,jjb,jje,zconvmm) 61 69 … … 64 72 if (pole_nord) jjb=jj_begin 65 73 if (pole_sud) jje=jj_end-1 66 pbarvm(:,jjb:jje,:)=pbarv(:,jjb:jje,:) 74 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 75 do l=1,llm 76 pbarvm(:,jjb:jje,l)=pbarv(:,jjb:jje,l) 77 enddo 78 c$OMP END DO NOWAIT 79 67 80 call groupeun_p(jjm,llm,jjb,jje,pbarvm) 68 81 … … 74 87 if (pole_sud) jje=jj_end-1 75 88 89 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 76 90 do l=1,llm 77 91 do j=jjb,jje … … 86 100 enddo 87 101 enddo 88 102 c$OMP END DO NOWAIT 89 103 c integration de la convergence de masse de haut en bas ...... 90 104 91 105 jjb=jj_begin 92 106 jje=jj_end 93 94 do l=1,llm 95 do j=jjb,jje 96 do i=1,iip1 97 zconvmm(i,j,l)=zconvmm(i,j,l) 98 enddo 99 enddo 100 enddo 101 107 108 c$OMP BARRIER 109 c$OMP MASTER 102 110 do l = llm-1,1,-1 103 111 do j=jjb,jje … … 107 115 enddo 108 116 enddo 109 117 110 118 if (.not. pole_sud) then 111 119 zconvmm(:,jj_end+1,:)=0 112 wm(:,jj_end+1,:)=0120 cym wm(:,jj_end+1,:)=0 113 121 endif 122 123 c$OMP END MASTER 124 c$OMP BARRIER 125 114 126 CALL vitvert_p(zconvmm(1,1,1),wm(1,1,1)) 115 127 -
LMDZ4/trunk/libf/dyn3dpar/groupeun_p.F
r630 r764 21 21 Champs 3D 22 22 jd=jjp1-jjmax 23 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 23 24 do l=1,llm 24 25 j1=1+jd … … 72 73 enddo 73 74 enddo 74 75 c$OMP END DO NOWAIT 75 76 return 76 77 end -
LMDZ4/trunk/libf/dyn3dpar/guide_p.F
r630 r764 82 82 INTEGER step_rea,count_no_rea 83 83 84 real aire_min,aire_max84 c real aire_min,aire_max 85 85 integer ilon,ilat 86 86 real factt,ztau(ip1jmp1) 87 87 88 88 INTEGER itau,ij,l,i,j 89 integer ncid t,varidpl,nlev,status89 integer ncidpl,varidpl,nlev,status 90 90 integer rcod,rid 91 91 real ditau,tau,a … … 218 218 step_rea=1 219 219 count_no_rea=0 220 220 ncidpl=-99 221 221 c itau_test montre si l'importation a deja ete faite au rang itau 222 222 c lecture d'un fichier netcdf pour determiner le nombre de niveaux 223 if (mpi_rank==0) then 224 ncidt=NCOPN('T.nc',NCNOWRIT,rcod) 223 IF (mpi_rank==0) THEN 224 225 if (guide_u) then 226 if (ncidpl.eq.-99) ncidpl=NCOPN('u.nc',NCNOWRIT,rcod) 227 endif 228 c 229 if (guide_v) then 230 if (ncidpl.eq.-99) ncidpl=NCOPN('v.nc',NCNOWRIT,rcod) 231 endif 232 c 233 if (guide_T) then 234 if (ncidpl.eq.-99) ncidpl=NCOPN('T.nc',NCNOWRIT,rcod) 235 endif 236 c 237 if (guide_Q) then 238 if (ncidpl.eq.-99) ncidpl=NCOPN('hur.nc',NCNOWRIT,rcod) 239 endif 240 c 225 241 if (ncep) then 226 status=NF_INQ_DIMID(ncid t,'LEVEL',rid)242 status=NF_INQ_DIMID(ncidpl,'LEVEL',rid) 227 243 else 228 status=NF_INQ_DIMID(ncid t,'PRESSURE',rid)229 endif 230 status=NF_INQ_DIMLEN(ncid t,rid,nlev)244 status=NF_INQ_DIMID(ncidpl,'PRESSURE',rid) 245 endif 246 status=NF_INQ_DIMLEN(ncidpl,rid,nlev) 231 247 print *,'nlev', nlev 232 call ncclos(ncidt,rcod) 233 endif 248 call ncclos(ncidpl,rcod) 249 250 ENDIF 234 251 235 252 c Lecture du premier etat des reanalyses. … … 338 355 tau=tau-aint(tau) 339 356 340 print*,'ATTENTION !!!! ON NE GUIDE QUE JUSQU A 15N'341 342 357 c ucov 343 358 ijb=ij_begin … … 532 547 zlat=rlatv(j)*180./pi 533 548 endif 549 if (abs(grossismx-1.).lt.0.1.or.abs(grossismy-1.).lt.0.1) then 550 c pour une grille reguliere, xi=xxx**0=1 -> alpha=alphamin 551 alpha(i,j)=alphamin 552 else 534 553 xi=((dxdy_max-dxdy_)/(dxdy_max-dxdy_min))**gamma 535 c pour une grille reguliere, xi=xxx**0=1 -> alpha=alphamin536 554 xi=min(xi,1.) 537 555 if(lat_min_guide.le.zlat .and. zlat.le.lat_max_guide) then … … 540 558 alpha(i,j)=0. 541 559 endif 560 endif 542 561 enddo 543 562 enddo -
LMDZ4/trunk/libf/dyn3dpar/iniadvtrac.F
r630 r764 6 6 subroutine iniadvtrac(nq) 7 7 USE ioipsl 8 #ifdef INCA9 USE transport_controls, only : hadv_flg, vadv_flg10 cym USE chemshut11 USE species_names12 #endif13 8 IMPLICIT NONE 14 9 c======================================================================= … … 60 55 descrq(30)='PRA' 61 56 57 #ifdef INCA 58 59 CALL init_transport( 60 $ hadv_flg, 61 $ vadv_flg, 62 $ conv_flg, 63 $ pbl_flg, 64 $ tracnam) 65 #endif 66 62 67 c----------------------------------------------------------------------- 63 68 c Choix des schemas d'advection pour l'eau et les traceurs … … 110 115 tnom(2)='H2Ol' 111 116 nq=nbtrac+2 117 112 118 if (nq.gt.nqmx) then 113 print*,'nombre de traceurs incompatible INCA/LMDZT' 119 print*,'nombre de traceurs incompatible INCA/LMDZT', nq, nbtrac 114 120 stop 115 121 endif … … 193 199 str1=tnom(iq) 194 200 tname(iiq)=tnom(iq) 195 ttext(iiq)=str1(1:lnblnk(str1))//descrq(iadv(iiq)) 201 IF (iadv(iiq).eq.0) THEN 202 ttext(iiq)=str1(1:lnblnk(str1)) 203 ELSE 204 ttext(iiq)=str1(1:lnblnk(str1))//descrq(iadv(iiq)) 205 ENDIF 196 206 str2=ttext(iiq) 197 207 c schemas tenant compte des moments d'ordre superieur. -
LMDZ4/trunk/libf/dyn3dpar/integrd_p.F
r630 r764 4 4 SUBROUTINE integrd_p 5 5 $ ( nq,vcovm1,ucovm1,tetam1,psm1,massem1, 6 $ dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps ,masse,phis,finvmaold)6 $ dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps0,masse,phis,finvmaold) 7 7 USE parallel 8 8 IMPLICIT NONE … … 41 41 REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm) 42 42 REAL q(ip1jmp1,llm,nq) 43 REAL ps (ip1jmp1),masse(ip1jmp1,llm),phis(ip1jmp1)43 REAL ps0(ip1jmp1),masse(ip1jmp1,llm),phis(ip1jmp1) 44 44 45 45 REAL vcovm1(ip1jm,llm),ucovm1(ip1jmp1,llm) … … 55 55 REAL vscr( ip1jm ),uscr( ip1jmp1 ),hscr( ip1jmp1 ),pscr(ip1jmp1) 56 56 REAL massescr( ip1jmp1,llm ), finvmasse(ip1jmp1,llm) 57 REAL p(ip1jmp1,llmp1)57 REAL,SAVE :: p(ip1jmp1,llmp1) 58 58 REAL tpn,tps,tppn(iim),tpps(iim) 59 59 REAL qpn,qps,qppn(iim),qpps(iim) … … 62 62 INTEGER l,ij,iq 63 63 64 EXTERNAL filtreg,massdair,pression65 EXTERNAL SCOPY66 64 REAL SSUM 67 65 EXTERNAL SSUM 68 66 INTEGER ijb,ije,jjb,jje 67 REAL,SAVE :: ps(ip1jmp1) 69 68 c----------------------------------------------------------------------- 69 70 70 if (pole_nord) THEN 71 71 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 72 72 DO l = 1,llm 73 73 DO ij = 1,iip1 … … 76 76 ENDDO 77 77 ENDDO 78 78 c$OMP END DO NOWAIT 79 79 ENDIF 80 80 81 81 if (pole_sud) THEN 82 82 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 83 83 DO l = 1,llm 84 84 DO ij = 1,iip1 … … 87 87 ENDDO 88 88 ENDDO 89 89 c$OMP END DO NOWAIT 90 90 ENDIF 91 91 … … 96 96 ijb=ij_begin 97 97 ije=ij_end 98 massescr(ijb:ije,:)=masse(ijb:ije,:) 99 98 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 99 DO l = 1,llm 100 massescr(ijb:ije,l)=masse(ijb:ije,l) 101 ENDDO 102 c$OMP END DO NOWAIT 103 104 c$OMP MASTER 100 105 DO 2 ij = ijb,ije 101 pscr (ij) = ps (ij)106 pscr (ij) = ps0(ij) 102 107 ps (ij) = psm1(ij) + dt * dp(ij) 103 108 2 CONTINUE … … 133 138 134 139 ENDIF 140 c$OMP END MASTER 141 c$OMP BARRIER 135 142 c 136 143 c ... Calcul de la nouvelle masse d'air au dernier temps integre t+1 ... 137 144 c 145 138 146 CALL pression_p ( ip1jmp1, ap, bp, ps, p ) 147 c$OMP BARRIER 139 148 CALL massdair_p ( p , masse ) 140 149 … … 142 151 ijb=ij_begin 143 152 ije=ij_end 144 finvmasse(ijb:ije,:)=masse(ijb:ije,:) 153 154 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 155 DO l = 1,llm 156 finvmasse(ijb:ije,l)=masse(ijb:ije,l) 157 ENDDO 158 c$OMP END DO NOWAIT 145 159 146 160 jjb=jj_begin … … 151 165 c ............ integration de ucov, vcov, h .............. 152 166 167 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 153 168 DO 10 l = 1,llm 154 169 … … 225 240 226 241 10 CONTINUE 227 242 c$OMP END DO NOWAIT 228 243 229 244 c … … 233 248 ije=ij_end 234 249 235 250 c$OMP MASTER 236 251 DO l = 1, llm 237 252 DO ij = ijb, ije … … 282 297 283 298 ENDIF 299 300 c$OMP END MASTER 301 c$OMP BARRIER 284 302 285 303 c CALL SCOPY( ijp1llm , finvmasse, 1, finvmaold, 1 ) 286 287 finvmaold(ijb:ije,:)=finvmasse(ijb:ije,:) 304 305 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 306 DO l = 1, llm 307 finvmaold(ijb:ije,l)=finvmasse(ijb:ije,l) 308 ENDDO 309 c$OMP END DO NOWAIT 288 310 c 289 311 c … … 292 314 15 continue 293 315 316 c$OMP MASTER 317 ps0(ijb:ije)=ps(ijb:ije) 318 c$OMP END MASTER 294 319 c ................................................................. 295 320 … … 298 323 c CALL SCOPY ( ip1jmp1 , pscr , 1, psm1 , 1 ) 299 324 c CALL SCOPY ( ip1jmp1*llm, massescr, 1, massem1, 1 ) 325 c$OMP MASTER 300 326 psm1(ijb:ije)=pscr(ijb:ije) 301 massem1(ijb:ije,:)=massescr(ijb:ije,:) 327 c$OMP END MASTER 328 329 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 330 DO l = 1, llm 331 massem1(ijb:ije,l)=massescr(ijb:ije,l) 332 ENDDO 333 c$OMP END DO NOWAIT 302 334 END IF 303 335 -
LMDZ4/trunk/libf/dyn3dpar/laplacien_gam_p.F
r630 r764 31 31 c ...................................................... 32 32 33 EXTERNAL filtreg34 EXTERNAL SCOPY, grad, divergst35 33 INTEGER :: ijb,ije 36 34 INTEGER :: l 37 35 c 38 36 c … … 49 47 if (pole_sud ) ije=ij_end 50 48 51 divgra(ijb:ije,klevel)=teta(ijb:ije,klevel) 49 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 50 DO l=1,klevel 51 divgra(ijb:ije,l)=teta(ijb:ije,l) 52 ENDDO 53 c$OMP END DO NOWAIT 54 52 55 c 53 56 CALL grad_p ( klevel, divgra, ghx, ghy ) -
LMDZ4/trunk/libf/dyn3dpar/laplacien_p.F
r630 r764 21 21 INTEGER klevel 22 22 REAL teta( ip1jmp1,klevel ), divgra( ip1jmp1,klevel ) 23 INTEGER :: l 23 24 c 24 25 c ............ variables locales .............. … … 27 28 c ....................................................... 28 29 29 EXTERNAL SCOPY, grad, divergf, filtreg30 30 31 31 INTEGER :: ijb,ije,jjb,jje … … 37 37 if (pole_nord) ijb=ij_begin 38 38 if (pole_sud ) ije=ij_end 39 40 divgra(ijb:ije,klevel)=teta(ijb:ije,klevel) 39 40 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 41 DO l=1,klevel 42 divgra(ijb:ije,l)=teta(ijb:ije,l) 43 ENDDO 44 c$OMP END DO NOWAIT 41 45 42 46 jjb=jj_begin-1 -
LMDZ4/trunk/libf/dyn3dpar/laplacien_rot_p.F
r630 r764 28 28 c ........................................................ 29 29 c 30 EXTERNAL filtreg, nxgrad, rotatf31 30 c 32 31 INTEGER :: ijb,ije,jjb,jje -
LMDZ4/trunk/libf/dyn3dpar/laplacien_rotgam_p.F
r630 r764 28 28 c ........................................................ 29 29 c 30 EXTERNAL nxgrad_gam, rotat_nfil31 30 INTEGER :: ijb,ije 32 31 … … 39 38 ije=ij_end 40 39 if(pole_sud) ije=ij_end-iip1 41 40 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 42 41 DO l = 1, klevel 43 42 DO ij = ijb, ije … … 45 44 ENDDO 46 45 ENDDO 47 46 c$OMP END DO NOWAIT 48 47 RETURN 49 48 END -
LMDZ4/trunk/libf/dyn3dpar/leapfrog_p.F
r630 r764 1 ! 1 ! 2 2 ! $Header$ 3 3 ! … … 6 6 #define IO_DEBUG 7 7 8 #undef CPP_IOIPSL8 !#undef CPP_IOIPSL 9 9 10 10 SUBROUTINE leapfrog_p(ucov,vcov,teta,ps,masse,phis,nq,q,clesphy0, … … 19 19 USE Write_Field_p 20 20 USE vampir 21 22 #ifdef INCA23 USE transport_controls, ONLY : hadv_flg, mmt_adj24 #endif25 21 26 22 IMPLICIT NONE … … 75 71 76 72 #include "academic.h" 73 #include "clesphys.h" 74 #include "advtrac.h" 77 75 78 76 include 'mpif.h' … … 146 144 147 145 REAL alpha(ip1jmp1,llm),beta(ip1jmp1,llm) 148 #ifdef INCA _CH4146 #ifdef INCA 149 147 REAL :: flxw(ip1jmp1,llm) 150 148 #endif … … 160 158 REAL d_h_vcol, d_qt, d_qw, d_ql, d_ec 161 159 CHARACTER*15 ztit 162 INTEGER ip_ebil_dyn ! PRINT level for energy conserv. diag.163 SAVE ip_ebil_dyn164 DATA ip_ebil_dyn/0/160 ! INTEGER ip_ebil_dyn ! PRINT level for energy conserv. diag. 161 ! SAVE ip_ebil_dyn 162 ! DATA ip_ebil_dyn/0/ 165 163 c-jld 166 164 … … 183 181 PARAMETER (testita = 9) 184 182 185 c declaration li ées au parallelisme183 c declaration liees au parallelisme 186 184 INTEGER :: ierr 187 185 LOGICAL :: FirstCaldyn=.TRUE. … … 198 196 INTEGER :: iapptrac = 0 199 197 INTEGER :: AdjustCount = 0 200 198 INTEGER :: var_time 201 199 ItCount=0 202 200 … … 225 223 c Debut de l'integration temporelle: 226 224 c ---------------------------------- 227 c et du parall élisme !!225 c et du parallelisme !! 228 226 229 227 1 CONTINUE 230 228 231 call MPI_BARRIER( MPI_COMM_WORLD,ierr)229 call MPI_BARRIER(COMM_LMDZ,ierr) 232 230 233 231 #ifdef CPP_IOIPSL 234 232 if (ok_guide.and.(itaufin-itau-1)*dtvr.gt.21600) then 235 call guide (itau,ucov,vcov,teta,q,masse,ps)233 call guide_pp(itau,ucov,vcov,teta,q,masse,ps) 236 234 else 237 235 IF(prt_level>9)WRITE(*,*)'attention on ne guide pas les ', … … 289 287 cym CALL filtreg ( finvmaold ,jjp1, llm, -2,2, .TRUE., 1 ) 290 288 291 cym ne sert àrien289 cym ne sert a rien 292 290 cym call minmax(ijp1llm,q(:,:,3),zqmin,zqmax) 293 291 … … 295 293 296 294 ItCount=ItCount+1 297 if (MOD(ItCount,1 0000)==0) then295 if (MOD(ItCount,1)==1) then 298 296 debug=.true. 299 297 else … … 315 313 conser = .FALSE. 316 314 apdiss = .FALSE. 317 315 c idissip=1 318 316 IF( purmats ) THEN 319 317 IF( MOD(itau,iconser) .EQ.0.AND. forward ) conser = .TRUE. … … 420 418 & jj_Nb_caldyn,0,0,TestRequest) 421 419 420 do j=1,nqmx 421 call Register_SwapFieldHallo(q(1,1,j),q(1,1,j),ip1jmp1,llm, 422 & jj_nb_caldyn,0,0,TestRequest) 423 enddo 424 422 425 call SetDistrib(jj_nb_caldyn) 423 426 call SendRequest(TestRequest) … … 469 472 call VTe(VThallo) 470 473 474 471 475 if (debug) then 472 473 476 call WriteField_p('ucov',reshape(ucov,(/iip1,jmp1,llm/))) 474 477 call WriteField_p('vcov',reshape(vcov,(/iip1,jjm,llm/))) … … 476 479 call WriteField_p('ps',reshape(ps,(/iip1,jmp1/))) 477 480 call WriteField_p('masse',reshape(masse,(/iip1,jmp1,llm/))) 481 call WriteField_p('pk',reshape(pk,(/iip1,jmp1,llm/))) 478 482 call WriteField_p('pks',reshape(pks,(/iip1,jmp1/))) 479 483 call WriteField_p('pkf',reshape(pkf,(/iip1,jmp1,llm/))) 480 484 call WriteField_p('phis',reshape(phis,(/iip1,jmp1/))) 481 cdo j=1,nqmx482 ccall WriteField_p('q'//trim(int2str(j)),483 c. reshape(q(:,:,j),(/iip1,jmp1,llm/)))484 cenddo485 do j=1,nqmx 486 call WriteField_p('q'//trim(int2str(j)), 487 . reshape(q(:,:,j),(/iip1,jmp1,llm/))) 488 enddo 485 489 endif 486 490 487 491 488 492 … … 497 501 498 502 call VTb(VTcaldyn) 499 503 504 var_time=time+iday-day_ini 505 OMP_CHUNK=5 506 c$OMP PARALLEL DEFAULT(SHARED) 507 cc$OMP+ SHARED(itau,ucov,vcov,teta,ps,masse,pk,pkf,phis , 508 cc$OMP+ phi,conser,du,dv,dteta,dp,w, pbaru,pbarv, 509 cc$OMP+ var_time) 510 500 511 CALL caldyn_p 501 512 $ ( itau,ucov,vcov,teta,ps,masse,pk,pkf,phis , 502 513 $ phi,conser,du,dv,dteta,dp,w, pbaru,pbarv, time+iday-day_ini ) 503 514 515 c$OMP END PARALLEL 504 516 call VTe(VTcaldyn) 505 517 c call WriteField_p('du',reshape(du,(/iip1,jmp1,llm/))) … … 516 528 517 529 IF( forward. OR . leapf ) THEN 518 519 c 520 #ifdef INCA _CH4530 c$OMP PARALLEL DEFAULT(SHARED) 531 c 532 #ifdef INCA 521 533 CALL caladvtrac_p(q,pbaru,pbarv, 522 534 * p, masse, dq, teta, 523 535 . flxw, 524 . pk, 525 . mmt_adj, 526 . hadv_flg,iapptrac) 536 . pk, 537 . iapptrac) 527 538 #else 528 539 CALL caladvtrac_p(q,pbaru,pbarv, … … 530 541 . pk,iapptrac) 531 542 #endif 543 544 c$OMP END PARALLEL 545 532 546 c do j=1,nqmx 533 547 c call WriteField_p('q'//trim(int2str(j)), 534 c . reshape(q(:,:,j),(/iip1,jmp1,llm/)))548 c . reshape(q(:,:,j),(/iip1,jmp1,llm/))) 535 549 c call WriteField_p('dq'//trim(int2str(j)), 536 550 c . reshape(dq(:,:,j),(/iip1,jmp1,llm/))) 537 551 c enddo 538 539 IF (offline) THEN 552 IF (offline) THEN 540 553 Cmaf stokage du flux de masse pour traceurs OFF-LINE 541 554 #undef CPP_IOIPSL 542 555 #ifdef CPP_IOIPSL 543 556 CALL fluxstokenc(pbaru,pbarv,masse,teta,phi,phis, … … 556 569 557 570 call VTb(VTintegre) 571 c call WriteField_p('ucovm1',reshape(ucovm1,(/iip1,jmp1,llm/))) 572 c call WriteField_p('vcovm1',reshape(vcovm1,(/iip1,jjm,llm/))) 573 c call WriteField_p('tetam1',reshape(tetam1,(/iip1,jmp1,llm/))) 574 c call WriteField_p('psm1',reshape(psm1,(/iip1,jmp1/))) 575 c call WriteField_p('ucov',reshape(ucov,(/iip1,jmp1,llm/))) 576 c call WriteField_p('vcov',reshape(vcov,(/iip1,jjm,llm/))) 577 c call WriteField_p('teta',reshape(teta,(/iip1,jmp1,llm/))) 578 c call WriteField_p('ps',reshape(ps,(/iip1,jmp1/))) 579 c$OMP PARALLEL DEFAULT(SHARED) 558 580 CALL integrd_p ( 2,vcovm1,ucovm1,tetam1,psm1,massem1 , 559 581 $ dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis , 560 582 $ finvmaold ) 561 583 584 c$OMP END PARALLEL 585 c call WriteField_p('ucovm1',reshape(ucovm1,(/iip1,jmp1,llm/))) 586 c call WriteField_p('vcovm1',reshape(vcovm1,(/iip1,jjm,llm/))) 587 c call WriteField_p('tetam1',reshape(tetam1,(/iip1,jmp1,llm/))) 588 c call WriteField_p('psm1',reshape(psm1,(/iip1,jmp1/))) 589 c call WriteField_p('ucov',reshape(ucov,(/iip1,jmp1,llm/))) 590 c call WriteField_p('vcov',reshape(vcov,(/iip1,jjm,llm/))) 591 c call WriteField_p('teta',reshape(teta,(/iip1,jmp1,llm/))) 592 c call WriteField_p('dteta',reshape(dteta,(/iip1,jmp1,llm/))) 593 594 c call WriteField_p('ps',reshape(ps,(/iip1,jmp1/))) 595 562 596 call VTe(VTintegre) 597 563 598 c .P.Le Van (26/04/94 ajout de finvpold dans l'appel d'integrd) 564 599 c … … 579 614 c ....... Ajout P.Le Van ( 17/04/96 ) ........... 580 615 c 616 c$OMP PARALLEL DEFAULT(SHARED) 617 c$OMP+ PRIVATE(rdaym_ini,rdayvrai,ijb,ije) 618 619 c$OMP MASTER 581 620 call suspend_timer(timer_caldyn) 582 621 print*,'Entree dans la physique : Iteration No ',true_itau 622 c$OMP END MASTER 623 583 624 CALL pression_p ( ip1jmp1, ap, bp, ps, p ) 625 c$OMP BARRIER 626 627 c$OMP MASTER 584 628 CALL exner_hyb_p( ip1jmp1, ps, p,alpha,beta,pks, pk, pkf ) 585 629 c$OMP END MASTER 630 c$OMP BARRIER 586 631 rdaym_ini = itau * dtvr / daysec 587 632 rdayvrai = rdaym_ini + day_ini … … 598 643 c+jld 599 644 600 c Diagnostique de conservation de l' énergie : initialisation645 c Diagnostique de conservation de l'energie : initialisation 601 646 IF (ip_ebil_dyn.ge.1 ) THEN 602 647 ztit='bil dyn' … … 605 650 ENDIF 606 651 c-jld 652 c$OMP BARRIER 653 c$OMP MASTER 607 654 call VTb(VThallo) 608 655 call SetTag(Request_physic,800) … … 638 685 * jj_Nb_physic,2,2,Request_physic) 639 686 enddo 640 #ifdef INCA _CH4687 #ifdef INCA 641 688 call Register_SwapFieldHallo(flxw,flxw,ip1jmp1,llm, 642 689 * jj_Nb_physic,2,2,Request_physic) … … 650 697 651 698 call VTb(VTphysiq) 699 c$OMP END MASTER 700 c$OMP BARRIER 701 702 cc$OMP MASTER 703 c call WriteField_p('ucovfi',reshape(ucov,(/iip1,jmp1,llm/))) 704 c call WriteField_p('vcovfi',reshape(vcov,(/iip1,jjm,llm/))) 705 c call WriteField_p('tetafi',reshape(teta,(/iip1,jmp1,llm/))) 706 c call WriteField_p('pfi',reshape(p,(/iip1,jmp1,llmp1/))) 707 c call WriteField_p('pkfi',reshape(pk,(/iip1,jmp1,llm/))) 708 cc$OMP END MASTER 709 cc$OMP BARRIER 710 652 711 CALL calfis_p( nq, lafin ,rdayvrai,time , 653 712 $ ucov,vcov,teta,q,masse,ps,p,pk,phis,phi , 654 713 $ du,dv,dteta,dq,w, 655 #ifdef INCA _CH4714 #ifdef INCA 656 715 $ flxw, 657 716 #endif 658 717 $ clesphy0, dufi,dvfi,dtetafi,dqfi,dpfi ) 659 660 718 ijb=ij_begin 661 719 ije=ij_end 662 720 if ( .not. pole_nord) then 663 dufi_tmp(1:iip1,:) = dufi(ijb:ijb+iim,:) 664 dvfi_tmp(1:iip1,:) = dvfi(ijb:ijb+iim,:) 665 dtetafi_tmp(1:iip1,:)= dtetafi(ijb:ijb+iim,:) 721 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 722 DO l=1,llm 723 dufi_tmp(1:iip1,l) = dufi(ijb:ijb+iim,l) 724 dvfi_tmp(1:iip1,l) = dvfi(ijb:ijb+iim,l) 725 dtetafi_tmp(1:iip1,l)= dtetafi(ijb:ijb+iim,l) 726 dqfi_tmp(1:iip1,l,:) = dqfi(ijb:ijb+iim,l,:) 727 ENDDO 728 c$OMP END DO NOWAIT 729 730 c$OMP MASTER 666 731 dpfi_tmp(1:iip1) = dpfi(ijb:ijb+iim) 667 dqfi_tmp(1:iip1,:,:) = dqfi(ijb:ijb+iim,:,:) 668 endif 669 732 c$OMP END MASTER 733 endif 734 735 c$OMP BARRIER 736 c$OMP MASTER 670 737 call SetDistrib(jj_nb_Physic_bis) 671 738 … … 695 762 696 763 call SetDistrib(jj_nb_Physic) 697 764 c$OMP END MASTER 765 c$OMP BARRIER 698 766 ijb=ij_begin 699 767 if (.not. pole_nord) then 700 dufi(ijb:ijb+iim,:) = dufi(ijb:ijb+iim,:)+dufi_tmp(1:iip1,:) 701 dvfi(ijb:ijb+iim,:) = dvfi(ijb:ijb+iim,:)+dvfi_tmp(1:iip1,:) 702 dtetafi(ijb:ijb+iim,:) = dtetafi(ijb:ijb+iim,:) 703 & +dtetafi_tmp(1:iip1,:) 768 769 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 770 DO l=1,llm 771 dufi(ijb:ijb+iim,l) = dufi(ijb:ijb+iim,l)+dufi_tmp(1:iip1,l) 772 dvfi(ijb:ijb+iim,l) = dvfi(ijb:ijb+iim,l)+dvfi_tmp(1:iip1,l) 773 dtetafi(ijb:ijb+iim,l) = dtetafi(ijb:ijb+iim,l) 774 & +dtetafi_tmp(1:iip1,l) 775 dqfi(ijb:ijb+iim,l,:) = dqfi(ijb:ijb+iim,l,:) 776 & + dqfi_tmp(1:iip1,l,:) 777 ENDDO 778 c$OMP END DO NOWAIT 779 780 c$OMP MASTER 704 781 dpfi(ijb:ijb+iim) = dpfi(ijb:ijb+iim)+ dpfi_tmp(1:iip1) 705 dqfi(ijb:ijb+iim,:,:) = dqfi(ijb:ijb+iim,:,:) 706 & + dqfi_tmp(1:iip1,:,:) 782 c$OMP END MASTER 783 707 784 endif 708 785 c$OMP BARRIER 786 cc$OMP MASTER 709 787 c call WriteField_p('dufi',reshape(dufi,(/iip1,jmp1,llm/))) 710 788 c call WriteField_p('dvfi',reshape(dvfi,(/iip1,jjm,llm/))) 711 789 c call WriteField_p('dtetafi',reshape(dtetafi,(/iip1,jmp1,llm/))) 712 790 c call WriteField_p('dpfi',reshape(dpfi,(/iip1,jmp1/))) 791 cc$OMP END MASTER 713 792 c 714 793 c do j=1,nqmx … … 723 802 $ dufi, dvfi, dtetafi , dqfi ,dpfi ) 724 803 804 c$OMP BARRIER 805 c$OMP MASTER 725 806 call VTe(VTphysiq) 726 807 … … 765 846 766 847 call SetDistrib(jj_Nb_caldyn) 767 c 768 c Diagnostique de conservation de l'énergie : difference 848 c$OMP END MASTER 849 c$OMP BARRIER 850 c 851 c Diagnostique de conservation de l'energie : difference 769 852 IF (ip_ebil_dyn.ge.1 ) THEN 770 853 ztit='bil phys' … … 772 855 e , ucov , vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2)) 773 856 ENDIF 774 775 if (debug) then 776 call WriteField_p('ucovfi',reshape(ucov,(/iip1,jmp1,llm/))) 777 call WriteField_p('vcovfi',reshape(vcov,(/iip1,jjm,llm/))) 778 call WriteField_p('tetafi',reshape(teta,(/iip1,jmp1,llm/))) 779 endif 857 858 cc$OMP MASTER 859 c if (debug) then 860 c call WriteField_p('ucovfi',reshape(ucov,(/iip1,jmp1,llm/))) 861 c call WriteField_p('vcovfi',reshape(vcov,(/iip1,jjm,llm/))) 862 c call WriteField_p('tetafi',reshape(teta,(/iip1,jmp1,llm/))) 863 c endif 864 cc$OMP END MASTER 865 780 866 #else 781 867 … … 799 885 800 886 c-jld 887 c$OMP MASTER 801 888 call resume_timer(timer_caldyn) 802 889 if (FirstPhysic) then … … 804 891 FirstPhysic=.false. 805 892 endif 893 c$OMP END MASTER 894 c$OMP END PARALLEL 806 895 ENDIF 807 896 … … 815 904 816 905 IF(apdiss) THEN 906 c$OMP PARALLEL DEFAULT(SHARED) 907 c$OMP+ PRIVATE(ijb,ije,tppn,tpn,tpps,tps) 908 c$OMP MASTER 817 909 call suspend_timer(timer_caldyn) 818 910 … … 822 914 823 915 call VTb(VThallo) 824 916 c$OMP END MASTER 917 918 c$OMP BARRIER 919 c$OMP MASTER 825 920 call Register_SwapFieldHallo(ucov,ucov,ip1jmp1,llm, 826 921 * jj_Nb_dissip,1,1,Request_dissip) … … 847 942 848 943 call start_timer(timer_dissip) 944 c$OMP END MASTER 945 c$OMP BARRIER 946 849 947 call covcont_p(llm,ucov,vcov,ucont,vcont) 850 948 call enercin_p(vcov,ucov,vcont,ucont,ecin0) … … 853 951 854 952 CALL dissip_p(vcov,ucov,teta,p,dvdis,dudis,dtetadis) 855 953 856 954 ijb=ij_begin 857 955 ije=ij_end 858 859 ucov(ijb:ije,1:llm)=ucov(ijb:ije,1:llm)+dudis(ijb:ije,1:llm) 860 956 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 957 DO l=1,llm 958 ucov(ijb:ije,l)=ucov(ijb:ije,l)+dudis(ijb:ije,l) 959 ENDDO 960 c$OMP END DO NOWAIT 861 961 if (pole_sud) ije=ije-iip1 862 vcov(ijb:ije,1:llm)=vcov(ijb:ije,1:llm)+dvdis(ijb:ije,1:llm) 962 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 963 DO l=1,llm 964 vcov(ijb:ije,l)=vcov(ijb:ije,l)+dvdis(ijb:ije,l) 965 ENDDO 966 c$OMP END DO NOWAIT 967 863 968 c teta=teta+dtetadis 864 969 … … 868 973 C On rajoute la tendance due a la transform. Ec -> E therm. cree 869 974 C lors de la dissipation 975 c$OMP BARRIER 976 c$OMP MASTER 870 977 call suspend_timer(timer_dissip) 871 978 call VTb(VThallo) … … 877 984 call VTe(VThallo) 878 985 call resume_timer(timer_dissip) 879 986 c$OMP END MASTER 987 c$OMP BARRIER 880 988 call covcont_p(llm,ucov,vcov,ucont,vcont) 881 989 call enercin_p(vcov,ucov,vcont,ucont,ecin) … … 883 991 ijb=ij_begin 884 992 ije=ij_end 885 993 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 886 994 do l=1,llm 887 995 do ij=ijb,ije … … 890 998 enddo 891 999 enddo 892 1000 c$OMP END DO NOWAIT 893 1001 endif 894 1002 895 1003 ijb=ij_begin 896 1004 ije=ij_end 897 1005 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 898 1006 do l=1,llm 899 1007 do ij=ijb,ije … … 901 1009 enddo 902 1010 enddo 903 1011 c$OMP END DO NOWAIT 904 1012 c------------------------------------------------------------------------ 905 1013 … … 913 1021 914 1022 if (pole_nord) then 1023 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 915 1024 DO l = 1, llm 916 1025 DO ij = 1,iim … … 923 1032 ENDDO 924 1033 ENDDO 925 1034 c$OMP END DO NOWAIT 1035 1036 c$OMP MASTER 926 1037 DO ij = 1,iim 927 1038 tppn(ij) = aire( ij ) * ps ( ij ) … … 932 1043 ps( ij ) = tpn 933 1044 ENDDO 1045 c$OMP END MASTER 934 1046 endif 935 1047 936 1048 if (pole_sud) then 1049 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 937 1050 DO l = 1, llm 938 1051 DO ij = 1,iim … … 945 1058 ENDDO 946 1059 ENDDO 947 1060 c$OMP END DO NOWAIT 1061 1062 c$OMP MASTER 948 1063 DO ij = 1,iim 949 1064 tpps(ij) = aire(ij+ip1jm) * ps (ij+ip1jm) … … 954 1069 ps(ij+ip1jm) = tps 955 1070 ENDDO 1071 c$OMP END MASTER 956 1072 endif 957 1073 1074 1075 c$OMP BARRIER 1076 c$OMP MASTER 958 1077 call VTe(VTdissipation) 959 1078 … … 983 1102 call resume_timer(timer_caldyn) 984 1103 print *,'fin dissipation' 1104 c$OMP END MASTER 1105 c$OMP END PARALLEL 985 1106 END IF 986 1107 … … 1066 1187 1067 1188 IF( itau. EQ. itaufinp1 ) then 1068 c$$$ write(79,*) 'ucov',ucov 1069 c$$$ write(80,*) 'vcov',vcov 1070 c$$$ write(81,*) 'teta',teta 1071 c$$$ write(82,*) 'ps',ps 1072 c$$$ write(83,*) 'q',q 1073 c$$$ WRITE(85,*) 'q1 = ',q(:,:,1) 1074 c$$$ WRITE(86,*) 'q3 = ',q(:,:,3) 1075 1189 1190 call finalize_parallel 1076 1191 abort_message = 'Simulation finished' 1077 1078 1192 call abort_gcm(modname,abort_message,0) 1079 1193 ENDIF … … 1161 1275 1162 1276 1163 #ifdef CPP_IOIPSL1277 c#ifdef CPP_IOIPSL 1164 1278 CALL dynredem1_p("restart.nc",0.0, 1165 1279 , vcov,ucov,teta,q,nqmx,masse,ps) 1166 #endif1280 c#endif 1167 1281 1168 1282 CLOSE(99) … … 1218 1332 forward = .FALSE. 1219 1333 IF( itau. EQ. itaufinp1 ) then 1334 call finalize_parallel 1220 1335 abort_message = 'Simulation finished' 1221 1336 call abort_gcm(modname,abort_message,0) … … 1296 1411 ENDIF 1297 1412 1298 #ifdef CPP_IOIPSL1413 c#ifdef CPP_IOIPSL 1299 1414 IF(itau.EQ.itaufin) 1300 1415 . CALL dynredem1_p("restart.nc",0.0, 1301 1416 . vcov,ucov,teta,q,nqmx,masse,ps) 1302 #endif1417 c#endif 1303 1418 1304 1419 forward = .TRUE. … … 1309 1424 END IF 1310 1425 1311 STOP 1426 call finalize_parallel 1427 STOP 1312 1428 END -
LMDZ4/trunk/libf/dyn3dpar/limx.F
r630 r764 48 48 REAL SSUM,CVMGP,CVMGT 49 49 integer ismax,ismin 50 EXTERNAL SSUM, convflu,ismin,ismax 51 EXTERNAL filtreg 50 EXTERNAL SSUM, ismin,ismax 52 51 53 52 data first/.true./ -
LMDZ4/trunk/libf/dyn3dpar/limy.F
r630 r764 52 52 REAL SSUM 53 53 integer ismax,ismin 54 EXTERNAL SSUM, convflu,ismin,ismax 55 EXTERNAL filtreg 54 EXTERNAL SSUM, ismin,ismax 56 55 57 56 data first/.true./ -
LMDZ4/trunk/libf/dyn3dpar/limz.F
r630 r764 48 48 REAL SSUM,CVMGP,CVMGT 49 49 integer ismax,ismin 50 EXTERNAL SSUM, convflu,ismin,ismax 51 EXTERNAL filtreg 50 EXTERNAL SSUM, ismin,ismax 52 51 53 52 data first/.true./ -
LMDZ4/trunk/libf/dyn3dpar/massbar_p.F
r630 r764 76 76 77 77 78 78 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 79 79 DO 100 l = 1 , llm 80 80 c … … 112 112 113 113 100 CONTINUE 114 c$OMP END DO NOWAIT 114 115 c 115 116 RETURN -
LMDZ4/trunk/libf/dyn3dpar/massbarxy_p.F
r630 r764 31 31 if (pole_sud) ije=ije-iip1 32 32 33 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 33 34 DO 100 l = 1 , llm 34 35 c … … 49 50 50 51 100 CONTINUE 52 c$OMP END DO NOWAIT 51 53 c 52 54 RETURN -
LMDZ4/trunk/libf/dyn3dpar/massdair_p.F
r630 r764 92 92 if (pole_sud) ije=ij_end 93 93 94 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 94 95 DO 100 l = 1 , llm 95 96 c … … 114 115 115 116 100 CONTINUE 117 c$OMP END DO NOWAIT 116 118 c 117 119 RETURN -
LMDZ4/trunk/libf/dyn3dpar/mod_hallo.F90
r630 r764 3 3 implicit none 4 4 ! include 'mpif.h' 5 integer, parameter :: MaxRequest= 805 integer, parameter :: MaxRequest=200 6 6 integer, parameter :: MaxProc=80 7 7 integer, parameter :: MaxBufferSize=1024*1024*16 … … 385 385 ! print *, 'process',MPI_RANK,'ISSEND: requette ',a_request%tag,'au process',rank,'de taille',SizeBuffer 386 386 ! call MPI_ISSEND(Req%Buffer,SizeBuffer,MPI_REAL8,rank,a_request%tag, & 387 ! MPI_COMM_WORLD,Req%MSG_Request,ierr)387 ! COMM_LMDZ,Req%MSG_Request,ierr) 388 388 call MPI_ISSEND(Buffer(req%Pos),SizeBuffer,MPI_REAL8,rank,a_request%tag, & 389 MPI_COMM_WORLD,Req%MSG_Request,ierr)389 COMM_LMDZ,Req%MSG_Request,ierr) 390 390 391 391 endif … … 410 410 411 411 ! call MPI_IRECV(Req%Buffer,SizeBuffer,MPI_REAL8,rank,a_request%tag, & 412 ! MPI_COMM_WORLD,Req%MSG_Request,ierr)412 ! COMM_LMDZ,Req%MSG_Request,ierr) 413 413 call MPI_IRECV(Buffer(Req%Pos),SizeBuffer,MPI_REAL8,rank,a_request%tag, & 414 MPI_COMM_WORLD,Req%MSG_Request,ierr)414 COMM_LMDZ,Req%MSG_Request,ierr) 415 415 416 416 endif … … 430 430 type(request_SR),pointer :: Req 431 431 type(Hallo),pointer :: PtrHallo 432 integer, dimension( 4) :: TabRequest433 integer, dimension(MPI_STATUS_SIZE, 4) :: TabStatus432 integer, dimension(2*mpi_size) :: TabRequest 433 integer, dimension(MPI_STATUS_SIZE,2*mpi_size) :: TabStatus 434 434 integer :: NbRequest 435 435 integer :: i,rank,pos,ij,l,ierr … … 512 512 type(request_SR),pointer :: Req 513 513 type(Hallo),pointer :: PtrHallo 514 integer, dimension( 4) :: TabRequest515 integer, dimension(MPI_STATUS_SIZE, 4) :: TabStatus514 integer, dimension(mpi_size) :: TabRequest 515 integer, dimension(MPI_STATUS_SIZE,mpi_size) :: TabStatus 516 516 integer :: NbRequest 517 517 integer :: i,rank,pos,ij,l,ierr … … 553 553 type(request_SR),pointer :: Req 554 554 type(Hallo),pointer :: PtrHallo 555 integer, dimension( 4) :: TabRequest556 integer, dimension(MPI_STATUS_SIZE, 4) :: TabStatus555 integer, dimension(mpi_size) :: TabRequest 556 integer, dimension(MPI_STATUS_SIZE,mpi_size) :: TabStatus 557 557 integer :: NbRequest 558 558 integer :: i,rank,pos,ij,l,ierr -
LMDZ4/trunk/libf/dyn3dpar/nxgrad_gam_p.F
r630 r764 22 22 INTEGER :: ijb,ije 23 23 c 24 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 24 25 DO 10 l = 1,klevel 25 26 c … … 62 63 c 63 64 10 CONTINUE 65 c$OMP END DO NOWAIT 64 66 RETURN 65 67 END -
LMDZ4/trunk/libf/dyn3dpar/nxgrad_p.F
r630 r764 21 21 c 22 22 c 23 23 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 24 24 DO 10 l = 1,klevel 25 25 c … … 63 63 c 64 64 10 CONTINUE 65 c$OMP END DO NOWAIT 65 66 RETURN 66 67 END -
LMDZ4/trunk/libf/dyn3dpar/nxgraro2_p.F
r630 r764 1 SUBROUTINE nxgraro2_p (klevel,xcov, ycov, lr, grx , gry)1 SUBROUTINE nxgraro2_p (klevel,xcov, ycov, lr, grx_out, gry_out ) 2 2 c 3 3 c P.Le Van . … … 25 25 INTEGER klevel 26 26 REAL xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel ) 27 REAL grx( ip1jmp1,klevel ), gry( ip1jm,klevel ) 27 REAL,SAVE :: grx( ip1jmp1,llm ), gry( ip1jm,llm ) 28 REAL grx_out( ip1jmp1,klevel ), gry_out( ip1jm,klevel ) 28 29 c 29 30 c ...... variables locales ........ 30 31 c 31 REAL rot(ip1jm,llm) , signe, nugradrs 32 REAL,SAVE :: rot(ip1jm,llm) 33 REAL signe, nugradrs 32 34 INTEGER l,ij,iter,lr 33 35 c ........................................................ 34 36 c 35 EXTERNAL filtreg36 EXTERNAL SCOPY, rotatf, nxgrad, laplacien_rotgam37 37 INTEGER :: ijb,ije,jjb,jje 38 38 … … 47 47 ijb=ij_begin 48 48 ije=ij_end 49 grx(ijb:ije,1:klevel)=xcov(ijb:ije,1:klevel) 50 49 50 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 51 DO l = 1, klevel 52 grx(ijb:ije,l)=xcov(ijb:ije,l) 53 ENDDO 54 c$OMP END DO NOWAIT 55 56 c$OMP BARRIER 57 c$OMP MASTER 51 58 call suspend_timer(timer_dissip) 52 59 call exchange_Hallo(grx,ip1jmp1,llm,0,1) 53 60 call resume_timer(timer_dissip) 61 c$OMP END MASTER 62 c$OMP BARRIER 54 63 55 64 ijb=ij_begin 56 65 ije=ij_end 57 66 if(pole_sud) ije=ij_end-iip1 58 gry(ijb:ije,1:klevel)=ycov(ijb:ije,1:klevel) 67 68 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 69 DO l = 1, klevel 70 gry(ijb:ije,l)=ycov(ijb:ije,l) 71 ENDDO 72 c$OMP END DO NOWAIT 73 59 74 c 60 75 CALL rotatf_p ( klevel, grx, gry, rot ) 61 76 c call write_field3d_p('rot1',reshape(rot,(/iip1,jjm,llm/))) 62 77 78 c$OMP BARRIER 79 c$OMP MASTER 63 80 call suspend_timer(timer_dissip) 64 81 call exchange_Hallo(rot,ip1jm,llm,1,1) 65 82 call resume_timer(timer_dissip) 83 c$OMP END MASTER 84 c$OMP BARRIER 66 85 67 86 CALL laplacien_rot_p ( klevel, rot, rot,grx,gry ) … … 71 90 c 72 91 DO iter = 1, lr -2 92 c$OMP BARRIER 93 c$OMP MASTER 73 94 call suspend_timer(timer_dissip) 74 95 call exchange_Hallo(rot,ip1jm,llm,1,1) 75 96 call resume_timer(timer_dissip) 97 c$OMP END MASTER 98 c$OMP BARRIER 76 99 CALL laplacien_rotgam_p ( klevel, rot, rot ) 77 100 ENDDO … … 86 109 87 110 CALL filtreg_p( rot, jjb,jje,jjm, klevel, 2,1, .FALSE.,1) 111 c$OMP BARRIER 112 c$OMP MASTER 88 113 call suspend_timer(timer_dissip) 89 114 call exchange_Hallo(rot,ip1jm,llm,1,0) 90 115 call resume_timer(timer_dissip) 116 c$OMP END MASTER 117 c$OMP BARRIER 91 118 CALL nxgrad_p ( klevel, rot, grx, gry ) 92 119 … … 94 121 ijb=ij_begin 95 122 ije=ij_end 96 123 124 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 97 125 DO l = 1, klevel 98 126 99 127 if(pole_sud) ije=ij_end-iip1 100 128 DO ij = ijb, ije 101 gry ( ij,l ) = gry( ij,l ) * nugradrs129 gry_out( ij,l ) = gry( ij,l ) * nugradrs 102 130 ENDDO 103 131 104 132 if(pole_sud) ije=ij_end 105 133 DO ij = ijb, ije 106 grx ( ij,l ) = grx( ij,l ) * nugradrs134 grx_out( ij,l ) = grx( ij,l ) * nugradrs 107 135 ENDDO 108 136 109 137 ENDDO 138 c$OMP END DO NOWAIT 110 139 c 111 140 RETURN -
LMDZ4/trunk/libf/dyn3dpar/nxgrarot_p.F
r630 r764 1 SUBROUTINE nxgrarot_p (klevel,xcov, ycov, lr, grx , gry)1 SUBROUTINE nxgrarot_p (klevel,xcov, ycov, lr, grx_out, gry_out ) 2 2 c *********************************************************** 3 3 c … … 26 26 INTEGER klevel 27 27 REAL xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel ) 28 REAL grx( ip1jmp1,klevel ), gry( ip1jm,klevel ) 28 REAL grx_out( ip1jmp1,klevel ), gry_out( ip1jm,klevel ) 29 REAL,SAVE :: grx( ip1jmp1,llm ), gry( ip1jm,llm ) 30 29 31 c 30 REAL rot(ip1jm,llm)32 REAL,SAVE :: rot(ip1jm,llm) 31 33 32 34 INTEGER l,ij,iter,lr 33 35 c 34 EXTERNAL filtreg35 EXTERNAL SCOPY, rotat, nXgrad36 36 INTEGER ijb,ije,jjb,jje 37 37 c … … 42 42 ijb=ij_begin 43 43 ije=ij_end 44 grx(ijb:ije,1:klevel)=xcov(ijb:ije,1:klevel) 45 44 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 45 DO l = 1, klevel 46 grx(ijb:ije,l)=xcov(ijb:ije,l) 47 ENDDO 48 c$OMP END DO NOWAIT 49 46 50 if(pole_sud) ije=ij_end-iip1 47 gry(ijb:ije,1:klevel)=ycov(ijb:ije,1:klevel) 51 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 52 DO l = 1, klevel 53 gry(ijb:ije,l)=ycov(ijb:ije,l) 54 ENDDO 55 c$OMP END DO NOWAIT 48 56 49 57 DO 10 iter = 1,lr 58 c$OMP BARRIER 59 c$OMP MASTER 50 60 call suspend_timer(timer_dissip) 51 61 call exchange_Hallo(grx,ip1jmp1,llm,0,1) 52 62 call resume_timer(timer_dissip) 63 c$OMP END MASTER 64 c$OMP BARRIER 65 53 66 CALL rotat_p (klevel,grx, gry, rot ) 54 67 c call write_field3d_p('rot',reshape(rot,(/iip1,jjm,llm/))) … … 58 71 if (pole_sud) jje=jj_end-1 59 72 CALL filtreg_p( rot,jjb,jje, jjm, klevel, 2,1, .false.,2) 60 73 74 c$OMP BARRIER 75 c$OMP MASTER 61 76 call suspend_timer(timer_dissip) 62 77 call exchange_Hallo(rot,ip1jm,llm,1,0) 63 78 call resume_timer(timer_dissip) 79 c$OMP END MASTER 80 c$OMP BARRIER 64 81 65 82 CALL nxgrad_p (klevel,rot, grx, gry ) 66 83 c 84 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 67 85 DO 5 l = 1, klevel 68 86 if(pole_sud) ije=ij_end-iip1 69 87 DO 2 ij = ijb, ije 70 gry ( ij,l ) = - gry( ij,l ) * crot88 gry_out( ij,l ) = - gry( ij,l ) * crot 71 89 2 CONTINUE 72 90 if(pole_sud) ije=ij_end 73 91 DO 3 ij = ijb, ije 74 grx ( ij,l ) = - grx( ij,l ) * crot92 grx_out( ij,l ) = - grx( ij,l ) * crot 75 93 3 CONTINUE 76 94 5 CONTINUE 77 95 c$OMP END DO NOWAIT 78 96 c call write_field3d_p('grx',reshape(grx,(/iip1,jjp1,llm/))) 79 97 c call write_field3d_p('gry',reshape(gry,(/iip1,jjm,llm/))) -
LMDZ4/trunk/libf/dyn3dpar/parallel.F90
r630 r764 3 3 integer, save :: mpi_size 4 4 integer, save :: mpi_rank 5 integer, save :: COMM_LMDZ 5 6 integer, save :: jj_begin 6 7 integer, save :: jj_end … … 14 15 integer, allocatable, save, dimension(:) :: jj_end_para 15 16 integer, allocatable, save, dimension(:) :: jj_nb_para 17 integer, save :: OMP_CHUNK 16 18 17 19 contains … … 19 21 subroutine init_parallel 20 22 USE vampir 23 #ifdef CPP_COUPLE 24 #ifdef CPP_PSMILE 25 USE mod_prism_proto 26 #endif 27 #endif 21 28 implicit none 22 29 … … 25 32 integer :: type_size 26 33 integer, dimension(3) :: blocklen,type 34 integer :: comp_id 27 35 28 36 … … 30 38 #include "dimensions90.h" 31 39 #include "paramet90.h" 32 40 41 #ifdef CPP_COUPLE 42 #ifdef CPP_PSMILE 43 call prism_init_comp_proto (comp_id, 'lmdz.x', ierr) 44 call prism_get_localcomm_proto(COMM_LMDZ,ierr) 45 #endif 46 #else 33 47 call MPI_INIT(ierr) 48 COMM_LMDZ=MPI_COMM_WORLD 49 #endif 34 50 call InitVampir 35 call MPI_COMM_SIZE( MPI_COMM_WORLD,mpi_size,ierr)36 call MPI_COMM_RANK( MPI_COMM_WORLD,mpi_rank,ierr)51 call MPI_COMM_SIZE(COMM_LMDZ,mpi_size,ierr) 52 call MPI_COMM_RANK(COMM_LMDZ,mpi_rank,ierr) 37 53 38 54 … … 50 66 print *," ---> diminuez le nombre de CPU ou augmentez la taille en lattitude" 51 67 52 call MPI_ABORT( MPI_COMM_WORLD,-1, ierr)68 call MPI_ABORT(COMM_LMDZ,-1, ierr) 53 69 54 70 endif … … 133 149 134 150 subroutine Finalize_parallel 151 #ifdef CPP_COUPLE 152 #ifdef CPP_PSMILE 153 use mod_prism_proto 154 #endif 155 #endif 135 156 implicit none 136 157 … … 144 165 deallocate(jj_end_para) 145 166 deallocate(jj_nb_para) 146 167 168 #ifdef CPP_COUPLE 169 #ifdef CPP_PSMILE 170 call prism_terminate_proto(ierr) 171 IF (ierr .ne. PRISM_Ok) THEN 172 call abort_gcm('Finalize_parallel',' Probleme dans prism_terminate_proto ',1) 173 endif 174 #endif 175 #else 147 176 call MPI_FINALIZE(ierr) 177 #endif 148 178 149 179 end subroutine Finalize_parallel 150 180 151 181 subroutine Pack_Data(Field,ij,ll,row,Buffer) 152 182 implicit none … … 217 247 INTEGER :: Buffer_size 218 248 219 call MPI_Barrier( MPI_COMM_WORLD,ierr)249 call MPI_Barrier(COMM_LMDZ,ierr) 220 250 call VTb(VThallo) 221 251 … … 253 283 call PACK_Data(Field(ij_begin,1),ij,ll,down,Buffer_Send_up) 254 284 call MPI_ISSEND(Buffer_send_up,Buffer_Size,MPI_REAL8,MPI_Rank-1,1, & 255 MPI_COMM_WORLD,Request(NbRequest),ierr)285 COMM_LMDZ,Request(NbRequest),ierr) 256 286 ENDIF 257 287 … … 264 294 265 295 call MPI_ISSEND(Buffer_send_down,Buffer_Size,MPI_REAL8,MPI_Rank+1,1, & 266 MPI_COMM_WORLD,Request(NbRequest),ierr)296 COMM_LMDZ,Request(NbRequest),ierr) 267 297 ENDIF 268 298 … … 274 304 275 305 call MPI_IRECV(Buffer_recv_up,Buffer_size,MPI_REAL8,MPI_Rank-1,1, & 276 MPI_COMM_WORLD,Request(NbRequest),ierr)306 COMM_LMDZ,Request(NbRequest),ierr) 277 307 278 308 … … 285 315 286 316 call MPI_IRECV(Buffer_recv_down,Buffer_size,MPI_REAL8,MPI_Rank+1,1, & 287 MPI_COMM_WORLD,Request(NbRequest),ierr)317 COMM_LMDZ,Request(NbRequest),ierr) 288 318 289 319 … … 295 325 296 326 call VTe(VThallo) 297 call MPI_Barrier( MPI_COMM_WORLD,ierr)327 call MPI_Barrier(COMM_LMDZ,ierr) 298 328 RETURN 299 329 … … 349 379 350 380 call MPI_GATHERV(Buffer_send,(min(ij_end,ij)-ij_begin+1)*ll,MPI_REAL8, & 351 Buffer_Recv,Recv_count,displ,MPI_REAL8,rank, MPI_COMM_WORLD,ierr)381 Buffer_Recv,Recv_count,displ,MPI_REAL8,rank,COMM_LMDZ,ierr) 352 382 353 383 if (MPI_Rank==rank) then … … 380 410 381 411 call Gather_Field(Field,ij,ll,0) 382 call MPI_BCAST(Field,ij*ll,MPI_REAL8,0, MPI_COMM_WORLD)412 call MPI_BCAST(Field,ij*ll,MPI_REAL8,0,COMM_LMDZ,ierr) 383 413 384 414 end subroutine AllGather_Field … … 395 425 INTEGER :: ierr 396 426 397 call MPI_BCAST(Field,ij*ll,MPI_REAL8,rank, MPI_COMM_WORLD)427 call MPI_BCAST(Field,ij*ll,MPI_REAL8,rank,COMM_LMDZ,ierr) 398 428 399 429 end subroutine Broadcast_Field -
LMDZ4/trunk/libf/dyn3dpar/pentes_ini.F
r630 r764 56 56 REAL SSUM 57 57 integer ismax,ismin,lati,latf 58 EXTERNAL SSUM, convflu,ismin,ismax58 EXTERNAL SSUM, ismin,ismax 59 59 logical first 60 60 save first 61 61 c fin modif 62 62 63 c EXTERNAL masskg64 EXTERNAL advx65 EXTERNAL advy66 EXTERNAL advz67 63 68 64 c modif Fred 24 03 96 -
LMDZ4/trunk/libf/dyn3dpar/ppm3d.F
r630 r764 737 737 c j=1 c'est le pôle Sud, j=JNP c'est le pôle Nord 738 738 Q(I, 2,k,IC) = Q(I, 1,k,IC) 739 Q(I,JMR,k,IC) = Q(I,J MP,k,IC)739 Q(I,JMR,k,IC) = Q(I,JNP,k,IC) 740 740 400 CONTINUE 741 741 endif -
LMDZ4/trunk/libf/dyn3dpar/prather.F
r630 r764 60 60 REAL SSUM 61 61 integer ismax,ismin 62 EXTERNAL SSUM, convflu,ismin,ismax62 EXTERNAL SSUM, ismin,ismax 63 63 logical first 64 64 save first 65 EXTERNAL advxp,advyp,advzp66 67 65 68 66 data first/.true./ -
LMDZ4/trunk/libf/dyn3dpar/pression_p.F
r630 r764 29 29 if (pole_nord) ijb=ij_begin 30 30 if (pole_sud) ije=ij_end 31 31 32 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 32 33 DO l = 1, llmp1 33 34 DO ij = ijb, ije … … 35 36 ENDDO 36 37 ENDDO 37 38 c$OMP END DO NOWAIT 38 39 RETURN 39 40 END -
LMDZ4/trunk/libf/dyn3dpar/read_reanalyse.F
r630 r764 10 10 c mode=1 variabels GCM 11 11 12 USE parallel 12 13 c ----------------------------------------------------------------- 13 14 c Declarations … … 42 43 integer ncidpl 43 44 integer varidpl,ncidQ,varidQ 44 save ncid u,varidu,ncidv,varidv,ncidt,varidt,ncidps,varidps45 save ncidpl,ncidu,varidu,ncidv,varidv,ncidt,varidt,ncidps,varidps 45 46 save varidpl,ncidQ,varidQ 46 47 … … 55 56 logical first 56 57 save first 58 INTEGER ierr 57 59 58 60 data first/.true./ … … 69 71 c Vent zonal 70 72 if (guide_u) then 71 ncidu=NCOPN('u.nc',NCNOWRIT,rcode)72 varidu=NCVID(ncidu,'UWND',rcode)73 print*,'ncidu,varidu',ncidu,varidu74 if (ncidpl.eq.-99) ncidpl=ncidu73 ncidu=NCOPN('u.nc',NCNOWRIT,rcode) 74 varidu=NCVID(ncidu,'UWND',rcode) 75 print*,'ncidu,varidu',ncidu,varidu 76 if (ncidpl.eq.-99) ncidpl=ncidu 75 77 endif 76 78 77 79 c Vent meridien 78 80 if (guide_v) then 79 ncidv=NCOPN('v.nc',NCNOWRIT,rcode) 80 varidv=NCVID(ncidv,'VWND',rcode) 81 print*,'ncidv,varidv',ncidv,varidv 82 if (ncidpl.eq.-99) ncidpl=ncidu 83 endif 81 ncidv=NCOPN('v.nc',NCNOWRIT,rcode) 82 varidv=NCVID(ncidv,'VWND',rcode) 83 print*,'ncidv,varidv',ncidv,varidv 84 if (ncidpl.eq.-99) ncidpl=ncidu 85 endif 86 84 87 85 88 c Temperature 86 89 if (guide_T) then 87 ncidt=NCOPN('T.nc',NCNOWRIT,rcode)88 varidt=NCVID(ncidt,'AIR',rcode)89 print*,'ncidt,varidt',ncidt,varidt90 if (ncidpl.eq.-99) ncidpl=ncidu91 endif 92 90 ncidt=NCOPN('T.nc',NCNOWRIT,rcode) 91 varidt=NCVID(ncidt,'AIR',rcode) 92 print*,'ncidt,varidt',ncidt,varidt 93 if (ncidpl.eq.-99) ncidpl=ncidu 94 endif 95 93 96 c Humidite 94 97 if (guide_Q) then 95 ncidQ=NCOPN('hur.nc',NCNOWRIT,rcode)96 varidQ=NCVID(ncidQ,'RH',rcode)97 print*,'ncidQ,varidQ',ncidQ,varidQ98 if (ncidpl.eq.-99) ncidpl=ncidu99 endif 100 98 ncidQ=NCOPN('hur.nc',NCNOWRIT,rcode) 99 varidQ=NCVID(ncidQ,'RH',rcode) 100 print*,'ncidQ,varidQ',ncidQ,varidQ 101 if (ncidpl.eq.-99) ncidpl=ncidu 102 endif 103 101 104 c Pression de surface 102 105 if (guide_P) then 103 ncidps=NCOPN('ps.nc',NCNOWRIT,rcode)104 varidps=NCVID(ncidps,'SP',rcode)105 print*,'ncidps,varidps',ncidps,varidps106 endif 107 106 ncidps=NCOPN('ps.nc',NCNOWRIT,rcode) 107 varidps=NCVID(ncidps,'SP',rcode) 108 print*,'ncidps,varidps',ncidps,varidps 109 endif 110 108 111 c Coordonnee vertcale 109 112 if (ncep) then … … 134 137 status=NF_GET_VARA_REAL(ncidpl,varidpl,1,nlevnc,pl) 135 138 #endif 139 136 140 c passage en pascal 137 141 pl(:)=100.*pl(:) … … 160 164 count(4)=1 161 165 166 167 c mise a zero des tableaux 168 c ------------------------ 169 unc(:,:,:)=0. 170 vnc(:,:,:)=0. 171 tnc(:,:,:)=0. 172 Qnc(:,:,:)=0. 173 162 174 c Vent zonal 163 175 c ---------- 164 176 165 177 if (guide_u) then 166 print*,'avant la lecture de UNCEP nd de niv:',nlevnc 178 print*,'avant la lecture de UNCEP nd de niv:',nlevnc 179 167 180 #ifdef NC_DOUBLE 168 status=NF_GET_VARA_DOUBLE(ncidu,varidu,start,count,unc)181 status=NF_GET_VARA_DOUBLE(ncidu,varidu,start,count,unc) 169 182 #else 170 status=NF_GET_VARA_REAL(ncidu,varidu,start,count,unc)183 status=NF_GET_VARA_REAL(ncidu,varidu,start,count,unc) 171 184 #endif 172 185 c call dump2d(iip1,jjp1,unc,'VENT NCEP ') 173 186 c call dump2d(iip1,40,unc(1,1,nlevnc),'VENT NCEP ') 174 print*,'WARNING!!! Correction bidon pour palier a un '175 print*,'probleme dans la creation des fichiers nc'176 call correctbid(iim,jjp1*nlevnc,unc)177 call dump2d(iip1,jjp1,unc,'UNC COUCHE 1 ')187 print*,'WARNING!!! Correction bidon pour palier a un ' 188 print*,'probleme dans la creation des fichiers nc' 189 call correctbid(iim,jjp1*nlevnc,unc) 190 call dump2d(iip1,jjp1,unc,'UNC COUCHE 1 ') 178 191 endif 179 192 … … 185 198 if (guide_T) then 186 199 #ifdef NC_DOUBLE 187 status=NF_GET_VARA_DOUBLE(ncidt,varidt,start,count,tnc)200 status=NF_GET_VARA_DOUBLE(ncidt,varidt,start,count,tnc) 188 201 #else 189 status=NF_GET_VARA_REAL(ncidt,varidt,start,count,tnc)202 status=NF_GET_VARA_REAL(ncidt,varidt,start,count,tnc) 190 203 #endif 191 call dump2d(iip1,jjp1,tnc,'TNC COUCHE 1 AAA ')192 call correctbid(iim,jjp1*nlevnc,tnc)193 call dump2d(iip1,jjp1,tnc,'TNC COUCHE 1 BBB ')204 call dump2d(iip1,jjp1,tnc,'TNC COUCHE 1 AAA ') 205 call correctbid(iim,jjp1*nlevnc,tnc) 206 call dump2d(iip1,jjp1,tnc,'TNC COUCHE 1 BBB ') 194 207 endif 195 208 … … 199 212 if (guide_Q) then 200 213 #ifdef NC_DOUBLE 201 status=NF_GET_VARA_DOUBLE(ncidQ,varidQ,start,count,Qnc)214 status=NF_GET_VARA_DOUBLE(ncidQ,varidQ,start,count,Qnc) 202 215 #else 203 status=NF_GET_VARA_REAL(ncidQ,varidQ,start,count,Qnc)216 status=NF_GET_VARA_REAL(ncidQ,varidQ,start,count,Qnc) 204 217 #endif 205 call correctbid(iim,jjp1*nlevnc,Qnc)206 call dump2d(iip1,jjp1,Qnc,'QNC COUCHE 1 ')218 call correctbid(iim,jjp1*nlevnc,Qnc) 219 call dump2d(iip1,jjp1,Qnc,'QNC COUCHE 1 ') 207 220 endif 208 221 … … 213 226 if (guide_v) then 214 227 #ifdef NC_DOUBLE 215 status=NF_GET_VARA_DOUBLE(ncidv,varidv,start,count,vnc)228 status=NF_GET_VARA_DOUBLE(ncidv,varidv,start,count,vnc) 216 229 #else 217 status=NF_GET_VARA_REAL(ncidv,varidv,start,count,vnc)230 status=NF_GET_VARA_REAL(ncidv,varidv,start,count,vnc) 218 231 #endif 219 call correctbid(iim,jjm*nlevnc,vnc)220 call dump2d(iip1,jjm,vnc,'VNC COUCHE 1 ')232 call correctbid(iim,jjm*nlevnc,vnc) 233 call dump2d(iip1,jjm,vnc,'VNC COUCHE 1 ') 221 234 endif 222 235 … … 232 245 if (guide_P) then 233 246 #ifdef NC_DOUBLE 234 status=NF_GET_VARA_DOUBLE(ncidps,varidps,start,count,psnc)247 status=NF_GET_VARA_DOUBLE(ncidps,varidps,start,count,psnc) 235 248 #else 236 status=NF_GET_VARA_REAL(ncidps,varidps,start,count,psnc)249 status=NF_GET_VARA_REAL(ncidps,varidps,start,count,psnc) 237 250 #endif 238 call dump2d(iip1,jjp1,psnc,'PSNC COUCHE 1 ')239 call correctbid(iim,jjp1,psnc)251 call dump2d(iip1,jjp1,psnc,'PSNC COUCHE 1 ') 252 call correctbid(iim,jjp1,psnc) 240 253 endif 241 254 -
LMDZ4/trunk/libf/dyn3dpar/rotat_nfil_p.F
r630 r764 32 32 ije=ij_end 33 33 if(pole_sud) ije=ij_end-iip1 34 34 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 35 35 DO 10 l = 1,klevel 36 36 c … … 48 48 c 49 49 10 CONTINUE 50 50 c$OMP END DO NOWAIT 51 51 RETURN 52 52 END -
LMDZ4/trunk/libf/dyn3dpar/rotat_p.F
r630 r764 33 33 if(pole_sud) ije=ij_end-iip1 34 34 35 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 35 36 DO 10 l = 1,klevel 36 37 c … … 48 49 c 49 50 10 CONTINUE 50 51 c$OMP END DO NOWAIT 51 52 ccc CALL filtreg( rot, jjm, klevel, 2, 2, .FALSE., 1 ) 52 53 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 53 54 DO l = 1, klevel 54 55 DO ij = ijb, ije … … 56 57 ENDDO 57 58 ENDDO 59 c$OMP END DO NOWAIT 58 60 c 59 61 c -
LMDZ4/trunk/libf/dyn3dpar/rotatf_p.F
r630 r764 32 32 ije=ij_end 33 33 if(pole_sud) ije=ij_end-iip1 34 34 35 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 35 36 DO 10 l = 1,klevel 36 37 c … … 48 49 c 49 50 10 CONTINUE 50 51 c$OMP END DO NOWAIT 51 52 jjb=jj_begin 52 53 jje=jj_end 53 54 if (pole_sud) jje=jj_end-1 54 55 CALL filtreg_p( rot, jjb,jje,jjm, klevel, 2, 2, .FALSE., 1 ) 55 56 57 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 56 58 DO l = 1, klevel 57 59 DO ij = ijb, ije … … 59 61 ENDDO 60 62 ENDDO 63 c$OMP END DO NOWAIT 61 64 c 62 65 c -
LMDZ4/trunk/libf/dyn3dpar/times.F90
r630 r764 126 126 V2=timer_table_sqr(jj_nb,no_timer,mpi_rank) 127 127 V=timer_table(jj_nb,no_timer,mpi_rank) 128 timer_delta(jj_nb,no_timer,mpi_rank)=sqrt( (V2-V*V/N)/(N-1))128 timer_delta(jj_nb,no_timer,mpi_rank)=sqrt(abs(V2-V*V/N)/(N-1)) 129 129 else 130 130 timer_delta(jj_nb,no_timer,mpi_rank)=0 … … 148 148 149 149 tmp_table(:,:)=timer_table(:,:,mpi_rank) 150 call mpi_allgather(tmp_table(1,1),data_size,MPI_REAL8,timer_table(1,1,mpi_rank),data_size,MPI_REAL8, MPI_COMM_WORLD,ierr)150 call mpi_allgather(tmp_table(1,1),data_size,MPI_REAL8,timer_table(1,1,mpi_rank),data_size,MPI_REAL8,COMM_LMDZ,ierr) 151 151 152 152 tmp_table(:,:)=timer_table_sqr(:,:,mpi_rank) 153 call mpi_allgather(tmp_table(1,1),data_size,MPI_REAL8,timer_table_sqr(1,1,mpi_rank),data_size,MPI_REAL8, MPI_COMM_WORLD,ierr)153 call mpi_allgather(tmp_table(1,1),data_size,MPI_REAL8,timer_table_sqr(1,1,mpi_rank),data_size,MPI_REAL8,COMM_LMDZ,ierr) 154 154 155 155 deallocate(tmp_table) … … 176 176 177 177 tmp_table(:,:)=timer_average(:,:,mpi_rank) 178 call mpi_allgather(tmp_table(1,1),data_size,MPI_REAL8,timer_average(1,1,0),data_size,MPI_REAL8, MPI_COMM_WORLD,ierr)178 call mpi_allgather(tmp_table(1,1),data_size,MPI_REAL8,timer_average(1,1,0),data_size,MPI_REAL8,COMM_LMDZ,ierr) 179 179 180 180 tmp_table(:,:)=timer_delta(:,:,mpi_rank) 181 call mpi_allgather(tmp_table(1,1),data_size,MPI_REAL8,timer_delta(1,1,0),data_size,MPI_REAL8, MPI_COMM_WORLD,ierr)181 call mpi_allgather(tmp_table(1,1),data_size,MPI_REAL8,timer_delta(1,1,0),data_size,MPI_REAL8,COMM_LMDZ,ierr) 182 182 183 183 tmp_iter(:,:)=timer_iteration(:,:,mpi_rank) 184 call mpi_allgather(tmp_iter(1,1),data_size,MPI_INTEGER,timer_iteration(1,1,0),data_size,MPI_INTEGER, MPI_COMM_WORLD,ierr)184 call mpi_allgather(tmp_iter(1,1),data_size,MPI_INTEGER,timer_iteration(1,1,0),data_size,MPI_INTEGER,COMM_LMDZ,ierr) 185 185 186 186 deallocate(tmp_table) -
LMDZ4/trunk/libf/dyn3dpar/tourpot_p.F
r630 r764 31 31 INTEGER l, ij ,ije,ijb,jje,jjb 32 32 33 EXTERNAL filtreg_p34 35 33 36 34 ijb=ij_begin-iip1 … … 45 43 46 44 c ........ Calcul du rotationnel du vent V puis filtrage ........ 47 45 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 48 46 DO 5 l = 1,llm 49 47 … … 65 63 66 64 5 CONTINUE 67 65 c$OMP END DO NOWAIT 68 66 jjb=jj_begin-1 69 67 jje=jj_end … … 73 71 CALL filtreg_p( rot, jjb,jje,jjm, llm, 2, 1, .FALSE., 1 ) 74 72 75 73 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 76 74 DO 10 l = 1, llm 77 75 … … 91 89 92 90 10 CONTINUE 93 91 c$OMP END DO NOWAIT 94 92 RETURN 95 93 END -
LMDZ4/trunk/libf/dyn3dpar/vitvert_p.F
r630 r764 38 38 39 39 if (pole_sud) ije=ij_end 40 40 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 41 41 DO 2 l = 1,llmm1 42 42 … … 46 46 47 47 2 CONTINUE 48 48 c$OMP END DO 49 c$OMP MASTER 49 50 DO 5 ij = ijb,ije 50 51 w(ij,1) = 0. 51 52 5 CONTINUE 52 53 c$OMP END MASTER 54 c$OMP BARRIER 53 55 RETURN 54 56 END -
LMDZ4/trunk/libf/dyn3dpar/vlsplt_p.F
r630 r764 228 228 REAL u_mq(ip1jmp1,llm) 229 229 230 Logical extremum,first,testcpu 231 SAVE first,testcpu 230 Logical extremum 232 231 233 232 REAL SSUM 234 233 EXTERNAL SSUM 235 REAL temps0,temps1,temps2,temps3,temps4,temps5,second236 SAVE temps0,temps1,temps2,temps3,temps4,temps5237 234 238 235 REAL z1,z2,z3 239 236 240 DATA first,testcpu/.true.,.false./241 237 INTEGER ijb,ije,ijb_x,ije_x 242 238 243 IF(first) THEN244 temps1=0.245 temps2=0.246 temps3=0.247 temps4=0.248 temps5=0.249 first=.false.250 ENDIF251 252 239 c calcul de la pente a droite et a gauche de la maille 253 240 … … 265 252 266 253 c calcul de la pente aux points u 267 254 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 268 255 DO l = 1, llm 269 256 … … 315 302 316 303 ENDDO ! l=1,llm 304 c$OMP END DO NOWAIT 317 305 c print*,'Ok calcul des pentes' 318 306 … … 321 309 c Pentes produits: 322 310 c ---------------- 323 311 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 324 312 DO l = 1, llm 325 313 DO ij=ijb,ije-1 … … 342 330 343 331 ENDDO 344 332 c$OMP END DO NOWAIT 345 333 ENDIF ! (pente_max.lt.-1.e-5) 346 334 347 335 c bouclage de la pente en iip1: 348 336 c ----------------------------- 349 337 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 350 338 DO l=1,llm 351 339 DO ij=ijb+iip1-1,ije,iip1 352 340 dxq(ij-iim,l)=dxq(ij,l) 353 341 ENDDO 354 DO ij= 1,ip1jmp1342 DO ij=ijb,ije 355 343 iadvplus(ij,l)=0 356 344 ENDDO 357 345 358 346 ENDDO 359 347 c$OMP END DO NOWAIT 360 348 c print*,'Bouclage en iip1' 361 349 … … 363 351 364 352 #ifdef CRAY 365 353 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 366 354 DO l=1,llm 367 355 DO ij=ijb,ije-1 … … 377 365 ENDDO 378 366 ENDDO 367 c$OMP END DO NOWAIT 379 368 #else 380 369 c on cumule le flux correspondant a toutes les mailles dont la masse 381 370 c au travers de la paroi pENDant le pas de temps. 382 371 c print*,'Cumule ....' 383 372 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 384 373 DO l=1,llm 385 374 DO ij=ijb,ije-1 … … 394 383 ENDDO 395 384 ENDDO 385 c$OMP END DO NOWAIT 396 386 #endif 397 387 c stop … … 400 390 c detection des points ou on advecte plus que la masse de la 401 391 c maille 392 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 402 393 DO l=1,llm 403 394 DO ij=ijb,ije-1 … … 408 399 ENDDO 409 400 ENDDO 401 c$OMP END DO NOWAIT 410 402 c print*,'Ok test 1' 403 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 411 404 DO l=1,llm 412 405 DO ij=ijb+iip1-1,ije,iip1 … … 414 407 ENDDO 415 408 ENDDO 409 c$OMP END DO NOWAIT 416 410 c print*,'Ok test 2' 417 411 … … 424 418 425 419 n0=0 420 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 426 421 DO l=1,llm 427 422 nl(l)=0 … … 431 426 n0=n0+nl(l) 432 427 ENDDO 433 428 c$OMP END DO NOWAIT 434 429 cym IF(n0.gt.1) THEN 435 IF(n0.gt.0) THEN430 cym IF(n0.gt.0) THEN 436 431 437 432 c PRINT*,'Nombre de points pour lesquels on advect plus que le' 438 433 c & ,'contenu de la maille : ',n0 439 434 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 440 435 DO l=1,llm 441 436 IF(nl(l).gt.0) THEN … … 487 482 ENDIF 488 483 ENDDO 489 ENDIF ! n0.gt.0 484 c$OMP END DO NOWAIT 485 cym ENDIF ! n0.gt.0 490 486 9999 continue 491 487 … … 493 489 c bouclage en latitude 494 490 c print*,'Avant bouclage en latitude' 491 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 495 492 DO l=1,llm 496 493 DO ij=ijb+iip1-1,ije,iip1 … … 498 495 ENDDO 499 496 ENDDO 500 497 c$OMP END DO NOWAIT 501 498 502 499 c calcul des tENDances 503 500 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 504 501 DO l=1,llm 505 502 DO ij=ijb+1,ije … … 516 513 ENDDO 517 514 ENDDO 515 c$OMP END DO NOWAIT 518 516 c CALL SCOPY((jjm-1)*llm,q(iip1+iip1,1),iip1,q(iip2,1),iip1) 519 517 c CALL SCOPY((jjm-1)*llm,masse(iip1+iip1,1),iip1,masse(iip2,1),iip1) … … 568 566 REAL temps0,temps1,temps2,temps3,temps4,temps5,second 569 567 SAVE temps0,temps1,temps2,temps3,temps4,temps5 568 c$OMP THREADPRIVATE(temps0,temps1,temps2,temps3,temps4,temps5) 570 569 SAVE first,testcpu 570 c$OMP THREADPRIVATE(first,testcpu) 571 571 572 572 REAL convpn,convps,convmpn,convmps … … 575 575 REAL coslon(iip1),coslondlon(iip1) 576 576 SAVE sinlon,coslon,sinlondlon,coslondlon 577 c$OMP THREADPRIVATE(sinlon,coslon,sinlondlon,coslondlon) 577 578 SAVE airej2,airejjm 579 c$OMP THREADPRIVATE(airej2,airejjm) 578 580 c 579 581 c … … 605 607 c PRINT*,'CALCUL EN LATITUDE' 606 608 607 609 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 608 610 DO l = 1, llm 609 611 c … … 806 808 807 809 ENDDO 810 c$OMP END DO NOWAIT 808 811 809 812 ijb=ij_begin-iip1 … … 812 815 if (pole_sud) ije=ij_end-iip1 813 816 814 817 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 815 818 DO l=1,llm 816 819 DO ij=ijb,ije … … 825 828 ENDDO 826 829 ENDDO 827 830 c$OMP END DO NOWAIT 828 831 829 832 ijb=ij_begin … … 832 835 if (pole_sud) ije=ij_end-iip1 833 836 837 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 834 838 DO l=1,llm 835 839 DO ij=ijb,ije … … 900 904 c._. fin nouvelle version 901 905 ENDDO 906 c$OMP END DO NOWAIT 902 907 903 908 RETURN … … 939 944 INTEGER i,ij,l,j,ii 940 945 c 941 REAL wq(ip1jmp1,llm+1),newmasse 942 943 REAL dzq(ip1jmp1,llm),dzqw(ip1jmp1,llm),adzqw(ip1jmp1,llm),dzqmax 946 REAL,SAVE :: wq(ip1jmp1,llm+1) 947 REAL newmasse 948 949 REAL,SAVE :: dzq(ip1jmp1,llm),dzqw(ip1jmp1,llm),adzqw(ip1jmp1,llm) 950 REAL dzqmax 944 951 REAL sigw 945 952 946 953 LOGICAL testcpu 947 954 SAVE testcpu 948 955 c$OMP THREADPRIVATE(testcpu) 949 956 REAL temps0,temps1,temps2,temps3,temps4,temps5,second 950 957 SAVE temps0,temps1,temps2,temps3,temps4,temps5 958 c$OMP THREADPRIVATE(temps0,temps1,temps2,temps3,temps4,temps5) 959 951 960 REAL SSUM 952 EXTERNAL SSUM, convflu 953 EXTERNAL filtreg 961 EXTERNAL SSUM 954 962 955 963 DATA testcpu/.false./ … … 967 975 ijb=ijb_x 968 976 ije=ije_x 969 977 978 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 970 979 DO l=2,llm 971 980 DO ij=ijb,ije … … 974 983 ENDDO 975 984 ENDDO 976 985 c$OMP END DO 986 987 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 977 988 DO l=2,llm-1 978 989 DO ij=ijb,ije … … 991 1002 ENDDO 992 1003 ENDDO 993 1004 c$OMP END DO NOWAIT 1005 1006 c$OMP MASTER 994 1007 DO ij=ijb,ije 995 1008 dzq(ij,1)=0. 996 1009 dzq(ij,llm)=0. 997 1010 ENDDO 998 1011 c$OMP END MASTER 1012 c$OMP BARRIER 999 1013 #ifdef BIDON 1000 1014 IF(testcpu) THEN … … 1008 1022 c calcul de - d( q * w )/ d(sigma) qu'on ajoute a dq pour calculer dq 1009 1023 1024 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1010 1025 DO l = 1,llm-1 1011 1026 do ij = ijb,ije … … 1019 1034 ENDDO 1020 1035 ENDDO 1021 1036 c$OMP END DO NOWAIT 1037 1038 c$OMP MASTER 1022 1039 DO ij=ijb,ije 1023 1040 wq(ij,llm+1)=0. 1024 1041 wq(ij,1)=0. 1025 1042 ENDDO 1026 1043 c$OMP END MASTER 1044 c$OMP BARRIER 1045 1046 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1027 1047 DO l=1,llm 1028 1048 DO ij=ijb,ije … … 1033 1053 ENDDO 1034 1054 ENDDO 1055 c$OMP END DO NOWAIT 1035 1056 1036 1057 -
LMDZ4/trunk/libf/dyn3dpar/vlspltqs_p.F
r630 r764 260 260 REAL u_mq(ip1jmp1,llm) 261 261 262 Logical first,testcpu263 SAVE first,testcpu264 265 262 REAL SSUM 266 REAL temps0,temps1,temps2,temps3,temps4,temps5 267 SAVE temps0,temps1,temps2,temps3,temps4,temps5 268 269 270 DATA first,testcpu/.true.,.false./ 263 271 264 272 265 INTEGER ijb,ije,ijb_x,ije_x 273 266 274 IF(first) THEN275 temps1=0.276 temps2=0.277 temps3=0.278 temps4=0.279 temps5=0.280 first=.false.281 ENDIF282 267 283 268 c calcul de la pente a droite et a gauche de la maille … … 299 284 300 285 c calcul de la pente aux points u 286 287 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 301 288 DO l = 1, llm 302 289 DO ij=ijb,ije-1 … … 347 334 348 335 ENDDO ! l=1,llm 336 c$OMP END DO NOWAIT 349 337 350 338 ELSE ! (pente_max.lt.-1.e-5) … … 352 340 c Pentes produits: 353 341 c ---------------- 354 342 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 355 343 DO l = 1, llm 356 344 DO ij=ijb,ije-1 … … 373 361 374 362 ENDDO 375 363 c$OMP END DO NOWAIT 376 364 ENDIF ! (pente_max.lt.-1.e-5) 377 365 378 366 c bouclage de la pente en iip1: 379 367 c ----------------------------- 380 368 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 381 369 DO l=1,llm 382 370 DO ij=ijb+iip1-1,ije,iip1 … … 389 377 390 378 ENDDO 391 392 if (pole_nord) iadvplus(1:iip1,1:llm)=0 393 if (pole_sud) iadvplus(ip1jm+1:ip1jmp1,1:llm)=0 394 379 c$OMP END DO NOWAIT 380 381 if (pole_nord) THEN 382 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 383 DO l=1,llm 384 iadvplus(1:iip1,l)=0 385 ENDDO 386 c$OMP END DO NOWAIT 387 endif 388 389 if (pole_sud) THEN 390 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 391 DO l=1,llm 392 iadvplus(ip1jm+1:ip1jmp1,l)=0 393 ENDDO 394 c$OMP END DO NOWAIT 395 endif 396 395 397 c calcul des flux a gauche et a droite 396 398 397 399 #ifdef CRAY 398 400 c--pas encore modification sur Qsat 401 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 399 402 DO l=1,llm 400 403 DO ij=ijb,ije-1 … … 410 413 ENDDO 411 414 ENDDO 415 c$OMP END DO NOWAIT 416 412 417 #else 413 418 c on cumule le flux correspondant a toutes les mailles dont la masse 414 419 c au travers de la paroi pENDant le pas de temps. 415 420 c le rapport de melange de l'air advecte est min(q_vanleer, Qsat_downwind) 421 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 416 422 DO l=1,llm 417 423 DO ij=ijb,ije-1 … … 427 433 ENDDO 428 434 ENDDO 435 c$OMP END DO NOWAIT 429 436 #endif 430 437 … … 432 439 c detection des points ou on advecte plus que la masse de la 433 440 c maille 441 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 434 442 DO l=1,llm 435 443 DO ij=ijb,ije-1 … … 440 448 ENDDO 441 449 ENDDO 450 c$OMP END DO NOWAIT 451 452 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 442 453 DO l=1,llm 443 454 DO ij=ijb+iip1-1,ije,iip1 … … 445 456 ENDDO 446 457 ENDDO 458 c$OMP END DO NOWAIT 447 459 448 460 … … 457 469 458 470 n0=0 471 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 459 472 DO l=1,llm 460 473 nl(l)=0 … … 464 477 n0=n0+nl(l) 465 478 ENDDO 466 479 c$OMP END DO NOWAIT 480 481 cym ATTENTION ICI en OpenMP reduction pas forcement nécessaire 467 482 cym IF(n0.gt.1) THEN 468 IF(n0.gt.0) THEN483 cym IF(n0.gt.0) THEN 469 484 ccc PRINT*,'Nombre de points pour lesquels on advect plus que le' 470 485 ccc & ,'contenu de la maille : ',n0 471 486 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 472 487 DO l=1,llm 473 488 IF(nl(l).gt.0) THEN … … 519 534 ENDIF 520 535 ENDDO 521 ENDIF ! n0.gt.0 536 c$OMP END DO NOWAIT 537 cym ENDIF ! n0.gt.0 522 538 523 539 524 540 525 541 c bouclage en latitude 526 542 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 527 543 DO l=1,llm 528 544 DO ij=ijb+iip1-1,ije,iip1 … … 530 546 ENDDO 531 547 ENDDO 532 548 c$OMP END DO NOWAIT 533 549 534 550 c calcul des tendances 535 551 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 536 552 DO l=1,llm 537 553 DO ij=ijb+1,ije … … 548 564 ENDDO 549 565 ENDDO 550 566 c$OMP END DO NOWAIT 551 567 c CALL SCOPY((jjm-1)*llm,q(iip1+iip1,1),iip1,q(iip2,1),iip1) 552 568 c CALL SCOPY((jjm-1)*llm,masse(iip1+iip1,1),iip1,masse(iip2,1),iip1) … … 597 613 REAL qpns,qpsn,dyn1,dys1,dyn2,dys2,newmasse,fn,fs 598 614 c REAL newq,oldmasse 599 Logical first,testcpu 600 REAL temps0,temps1,temps2,temps3,temps4,temps5 601 SAVE temps0,temps1,temps2,temps3,temps4,temps5 602 SAVE first,testcpu 603 615 Logical first 616 SAVE first 617 c$OMP THREADPRIVATE(first) 604 618 REAL convpn,convps,convmpn,convmps 605 619 REAL sinlon(iip1),sinlondlon(iip1) … … 607 621 SAVE sinlon,coslon,sinlondlon,coslondlon 608 622 SAVE airej2,airejjm 623 c$OMP THREADPRIVATE(sinlon,coslon,sinlondlon,coslondlon) 624 c$OMP THREADPRIVATE(airej2,airejjm) 609 625 c 610 626 c 611 627 REAL SSUM 612 628 613 DATA first,testcpu/.true.,.false./ 614 DATA temps0,temps1,temps2,temps3,temps4,temps5/0.,0.,0.,0.,0.,0./ 629 DATA first/.true./ 615 630 INTEGER ijb,ije 616 631 … … 634 649 c 635 650 636 651 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 637 652 DO l = 1, llm 638 653 c … … 833 848 834 849 ENDDO 850 c$OMP END DO NOWAIT 835 851 836 852 ijb=ij_begin-iip1 … … 839 855 if (pole_sud) ije=ij_end-iip1 840 856 857 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 841 858 DO l=1,llm 842 859 DO ij=ijb,ije … … 851 868 ENDDO 852 869 ENDDO 870 c$OMP END DO NOWAIT 853 871 854 872 ijb=ij_begin … … 856 874 if (pole_nord) ijb=ij_begin+iip1 857 875 if (pole_sud) ije=ij_end-iip1 858 876 877 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 859 878 DO l=1,llm 860 879 DO ij=ijb,ije … … 917 936 c._. fin nouvelle version 918 937 ENDDO 919 938 c$OMP END DO NOWAIT 920 939 RETURN 921 940 END -
LMDZ4/trunk/libf/grid/dimension/makdim
r524 r764 6 6 fichdim=dimensions${list}.t${nqmx} 7 7 8 if [ ! -f $fichdim ] ; then8 if [ ! -f $fichdim -o ! -f ${fichdim}_90 ] ; then 9 9 # si le fichier de dimensions n'existe pas, on le cree 10 10 … … 65 65 c----------------------------------------------------------------------- 66 66 EOF 67 68 cat << EOF > ${fichdim}_90 69 !----------------------------------------------------------------------- 70 ! INCLUDE 'dimensions90.h' 71 ! 72 ! dimensions90.h contient les dimensions du modele 73 ! ndm est tel que iim=2**ndm 74 ! nqmx est la dimension de la variable traceur q 75 !----------------------------------------------------------------------- 76 77 INTEGER iim,jjm,llm,ndm 78 79 PARAMETER (iim= $im,jjm=$jm,llm=$lm,ndm=$ndm) 80 81 integer nqmx 82 parameter (nqmx=$nqmx) 83 84 !----------------------------------------------------------------------- 85 EOF 67 86 fi 68 87 69 88 \rm ../dimensions.h 89 \rm ../dimensions90.h 70 90 tar cf - $fichdim | ( cd .. ; tar xf - ; mv $fichdim dimensions.h ) 91 tar cf - ${fichdim}_90 | ( cd .. ; tar xf - ; mv ${fichdim}_90 dimensions90.h )
Note: See TracChangeset
for help on using the changeset viewer.
