Changeset 764 for LMDZ4/trunk/libf/dyn3dpar/advtrac_p.F
- Timestamp:
- Jun 4, 2007, 4:13:10 PM (17 years ago)
- File:
-
- 1 edited
-
LMDZ4/trunk/libf/dyn3dpar/advtrac_p.F (modified) (21 diffs)
Legend:
- Unmodified
- Added
- Removed
-
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
Note: See TracChangeset
for help on using the changeset viewer.
