Changeset 916 for LMDZ4/branches
- Timestamp:
- Feb 27, 2008, 4:19:37 PM (17 years ago)
- Location:
- LMDZ4/branches/LMDZ4_V3_patches/libf/dyn3dpar
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/branches/LMDZ4_V3_patches/libf/dyn3dpar/bilan_dyn_p.F
r764 r916 15 15 use misc_mod 16 16 use write_field 17 USE Write_Field_p 17 18 IMPLICIT NONE 18 19 … … 164 165 type(Request) :: Req 165 166 167 ! definition du domaine d'ecriture pour le rebuild 168 169 INTEGER,DIMENSION(1) :: ddid 170 INTEGER,DIMENSION(1) :: dsg 171 INTEGER,DIMENSION(1) :: dsl 172 INTEGER,DIMENSION(1) :: dpf 173 INTEGER,DIMENSION(1) :: dpl 174 INTEGER,DIMENSION(1) :: dhs 175 INTEGER,DIMENSION(1) :: dhe 176 177 INTEGER :: bilan_dyn_domain_id 178 166 179 167 180 c===================================================================== … … 233 246 jje=jj_end 234 247 jjn=jj_nb 235 if (pole_sud) jjn=jj_nb-1 248 IF (pole_sud) THEN 249 jjn=jj_nb-1 250 jje=jj_end-1 251 ENDIF 252 253 ddid=(/ 2 /) 254 dsg=(/ jjm /) 255 dsl=(/ jjn /) 256 dpf=(/ jjb /) 257 dpl=(/ jje /) 258 dhs=(/ 0 /) 259 dhe=(/ 0 /) 260 261 call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, 262 . 'box',bilan_dyn_domain_id) 236 263 237 call histbeg(trim(infile) //'_'//trim(int2str(mpi_rank)),264 call histbeg(trim(infile), 238 265 . 1, rlong(jjb:jje), jjn, rlatg(jjb:jje), 239 266 . 1, 1, 1, jjn, 240 . tau0, zjulian, dt_cum, thoriid, fileid) 267 . tau0, zjulian, dt_cum, thoriid, fileid, 268 . bilan_dyn_domain_id) 241 269 242 270 C … … 352 380 c 353 381 if(icum.EQ.0) then 354 ps_cum=0. 355 masse_cum=0. 356 flux_u_cum=0. 357 flux_v_cum=0. 358 Q_cum=0. 359 flux_vQ_cum=0. 360 flux_uQ_cum=0. 382 jjb=jj_begin 383 jje=jj_end 384 385 ps_cum(:,jjb:jje)=0. 386 masse_cum(:,jjb:jje,:)=0. 387 flux_u_cum(:,jjb:jje,:)=0. 388 Q_cum(:,jjb:jje,:,:)=0. 389 flux_uQ_cum(:,jjb:jje,:,:)=0. 390 flux_v_cum(:,jjb:jje,:)=0. 391 if (pole_sud) jje=jj_end-1 392 flux_v_cum(:,jjb:jje,:)=0. 393 flux_vQ_cum(:,jjb:jje,:,:)=0. 361 394 endif 362 395 … … 366 399 367 400 c accumulation des flux de masse horizontaux 368 ps_cum=ps_cum+ps 369 masse_cum=masse_cum+masse 370 flux_u_cum=flux_u_cum+flux_u 371 flux_v_cum=flux_v_cum+flux_v 401 jjb=jj_begin 402 jje=jj_end 403 404 ps_cum(:,jjb:jje)=ps_cum(:,jjb:jje)+ps(:,jjb:jje) 405 masse_cum(:,jjb:jje,:)=masse_cum(:,jjb:jje,:)+masse(:,jjb:jje,:) 406 flux_u_cum(:,jjb:jje,:)=flux_u_cum(:,jjb:jje,:) 407 . +flux_u(:,jjb:jje,:) 408 if (pole_sud) jje=jj_end-1 409 flux_v_cum(:,jjb:jje,:)=flux_v_cum(:,jjb:jje,:) 410 . +flux_v(:,jjb:jje,:) 411 412 jjb=jj_begin 413 jje=jj_end 414 372 415 do iQ=1,nQ 373 416 Q_cum(:,jjb:jje,:,iQ)=Q_cum(:,jjb:jje,:,iQ) … … 396 439 c ------------- 397 440 do iQ=1,nQ 441 call Register_Hallo(Q(1,1,1,iQ),ip1jmp1,llm,0,1,1,0,Req) 442 enddo 443 call SendRequest(Req) 444 call WaitRequest(Req) 445 446 jjb=jj_begin 447 jje=jj_end 448 if (pole_sud) jje=jj_end-1 449 450 do iQ=1,nQ 398 451 do l=1,llm 399 452 do j=jjb,jje … … 426 479 call convmas_p(flux_u_cum,flux_v_cum,convm) 427 480 CALL vitvert_p(convm,w) 481 482 jjb=jj_begin 483 jje=jj_end 428 484 429 485 do iQ=1,nQ … … 455 511 enddo 456 512 zz=1./float(ncum) 457 ps_cum=ps_cum*zz 458 masse_cum=masse_cum*zz 459 flux_u_cum=flux_u_cum*zz 460 flux_v_cum=flux_v_cum*zz 461 flux_uQ_cum=flux_uQ_cum*zz 462 flux_vQ_cum=flux_vQ_cum*zz 463 dQ=dQ*zz 513 514 jjb=jj_begin 515 jje=jj_end 516 517 ps_cum(:,jjb:jje)=ps_cum(:,jjb:jje)*zz 518 masse_cum(:,jjb:jje,:)=masse_cum(:,jjb:jje,:)*zz 519 flux_u_cum(:,jjb:jje,:)=flux_u_cum(:,jjb:jje,:)*zz 520 flux_uQ_cum(:,jjb:jje,:,:)=flux_uQ_cum(:,jjb:jje,:,:)*zz 521 dQ(:,jjb:jje,:,:)=dQ(:,jjb:jje,:,:)*zz 522 523 IF (pole_sud) jje=jj_end-1 524 flux_v_cum(:,jjb:jje,:)=flux_v_cum(:,jjb:jje,:)*zz 525 flux_vQ_cum(:,jjb:jje,:,:)=flux_vQ_cum(:,jjb:jje,:,:)*zz 526 527 jjb=jj_begin 528 jje=jj_end 464 529 465 530 … … 476 541 c cumul zonal des masses des mailles 477 542 c ---------------------------------- 478 zv=0. 479 zmasse=0. 480 call massbar(masse_cum,massebx,masseby) 543 jjb=jj_begin 544 jje=jj_end 545 if (pole_sud) jje=jj_end-1 546 547 zv(jjb:jje,:)=0. 548 zmasse(jjb:jje,:)=0. 549 550 call Register_Hallo(masse_cum,ip1jmp1,llm,1,1,1,1,Req) 551 do iQ=1,nQ 552 call Register_Hallo(Q_cum(1,1,1,iQ),ip1jmp1,llm,0,1,1,0,Req) 553 enddo 554 555 call SendRequest(Req) 556 call WaitRequest(Req) 557 558 call massbar_p(masse_cum,massebx,masseby) 481 559 482 560 jjb=jj_begin … … 524 602 c ---------------------------------------- 525 603 604 jjb=jj_begin 605 jje=jj_end 606 if (pole_sud) jje=jj_end-1 607 526 608 zvQ=0. 527 609 psiQ=0. … … 560 642 561 643 c fonction de courant pour la circulation meridienne moyenne 562 psi =0.644 psi(jjb:jje,:)=0. 563 645 do l=llm,1,-1 564 646 do j=jjb,jje … … 588 670 enddo 589 671 590 call histwrite(fileid,'masse',itau,zmasse(jjb:jje,1 )672 call histwrite(fileid,'masse',itau,zmasse(jjb:jje,1:llm) 591 673 s ,jjn*llm,ndex3d) 592 call histwrite(fileid,'v',itau,zv(jjb:jje,1 )674 call histwrite(fileid,'v',itau,zv(jjb:jje,1:llm) 593 675 s ,jjn*llm,ndex3d) 594 psi =psi*1.e-9676 psi(jjb:jje,:)=psi(jjb:jje,:)*1.e-9 595 677 call histwrite(fileid,'psi',itau,psi(jjb:jje,1:llm), 596 678 s jjn*llm,ndex3d) … … 603 685 c ----------------- 604 686 605 zamasse =0.687 zamasse(jjb:jje)=0. 606 688 do l=1,llm 607 689 zamasse(jjb:jje)=zamasse(jjb:jje)+zmasse(jjb:jje,l) 608 690 enddo 609 zavQ=0. 691 692 zavQ(jjb:jje,:,:)=0. 610 693 do iQ=1,nQ 611 694 do itr=2,ntr -
LMDZ4/branches/LMDZ4_V3_patches/libf/dyn3dpar/gcm.F
r853 r916 404 404 t_ops = iecri * daysec 405 405 t_wrt = iecri * daysec 406 CALL inithist_p(dynhist_file,day_ref,annee_ref,time_step,407 . t_ops, t_wrt, nqmx, histid, histvid)406 c CALL inithist_p(dynhist_file,day_ref,annee_ref,time_step, 407 c . t_ops, t_wrt, nqmx, histid, histvid) 408 408 409 409 t_ops = iperiod * time_step 410 410 t_wrt = periodav * daysec 411 CALL initdynav_p(dynhistave_file,day_ref,annee_ref,time_step,412 . t_ops, t_wrt, nqmx, histaveid)411 c CALL initdynav_p(dynhistave_file,day_ref,annee_ref,time_step, 412 c . t_ops, t_wrt, nqmx, histaveid) 413 413 414 414 dtav = iperiod*dtvr/daysec -
LMDZ4/branches/LMDZ4_V3_patches/libf/dyn3dpar/gr_u_scal_p.F
r790 r916 50 50 ijb=ij_begin 51 51 ije=ij_end 52 if (pole_nord) ijb=ij_begin+ 152 if (pole_nord) ijb=ij_begin+iip1 53 53 54 54 DO l=1,nx -
LMDZ4/branches/LMDZ4_V3_patches/libf/dyn3dpar/gr_v_scal_p.F
r774 r916 49 49 ijb=ij_begin 50 50 ije=ij_end 51 if (pole_nord) ijb=ij_begin+ 152 if (pole_sud) ije=ij_end- 151 if (pole_nord) ijb=ij_begin+iip1 52 if (pole_sud) ije=ij_end-iip1 53 53 54 54 DO l=1,nx -
LMDZ4/branches/LMDZ4_V3_patches/libf/dyn3dpar/leapfrog_p.F
r774 r916 6 6 #define IO_DEBUG 7 7 8 !#undef CPP_IOIPSL8 c#undef CPP_IOIPSL 9 9 10 10 SUBROUTINE leapfrog_p(ucov,vcov,teta,ps,masse,phis,nq,q,clesphy0, … … 481 481 c$OMP MASTER 482 482 call VTb(VThallo) 483 c$OMP END MASTER 484 483 485 call Register_Hallo(ucov,ip1jmp1,llm,1,1,1,1,TestRequest) 484 486 call Register_Hallo(vcov,ip1jm,llm,1,1,1,1,TestRequest) … … 496 498 497 499 call SendRequest(TestRequest) 500 c$OMP BARRIER 498 501 call WaitRequest(TestRequest) 502 503 c$OMP MASTER 499 504 call VTe(VThallo) 500 505 c$OMP END MASTER 506 c$OMP BARRIER 501 507 502 508 if (debug) then … … 514 520 . reshape(q(:,:,j),(/iip1,jmp1,llm/))) 515 521 enddo 522 c$OMP BARRIER 516 523 endif 517 c$OMP END MASTER 518 c$OMP BARRIER 524 519 525 520 526 True_itau=True_itau+1 … … 531 537 call VTb(VTcaldyn) 532 538 c$OMP END MASTER 533 c$OMP BARRIER534 539 var_time=time+iday-day_ini 535 cc$OMP PARALLEL DEFAULT(SHARED) 536 cc$OMP+ PRIVATE(rdaym_ini,rdayvrai,ijb,ije, 537 cc$OMP+ tppn,tpn,tpps,tps) 538 539 cc$OMP+ SHARED(itau,ucov,vcov,teta,ps,masse,pk,pkf,phis , 540 cc$OMP+ phi,conser,du,dv,dteta,dp,w, pbaru,pbarv, 541 cc$OMP+ time, iday,day_ini,forward,leapf, iapptrac, 542 cc$OMP+ q,dq,p,VTcaldyn,offline,dtvr,itau) 543 540 541 c$OMP BARRIER 542 ! CALL FTRACE_REGION_BEGIN("caldyn") 544 543 CALL caldyn_p 545 544 $ ( itau,ucov,vcov,teta,ps,masse,pk,pkf,phis , 546 545 $ phi,conser,du,dv,dteta,dp,w, pbaru,pbarv, time+iday-day_ini ) 547 546 548 ccc$OMP END PARALLEL 547 ! CALL FTRACE_REGION_END("caldyn") 549 548 c$OMP MASTER 550 549 call VTe(VTcaldyn) 551 550 c$OMP END MASTER 551 552 cc$OMP BARRIER 553 cc$OMP MASTER 552 554 c call WriteField_p('du',reshape(du,(/iip1,jmp1,llm/))) 553 555 c call WriteField_p('dv',reshape(dv,(/iip1,jjm,llm/))) … … 557 559 c call WriteField_p('pbaru',reshape(pbaru,(/iip1,jmp1,llm/))) 558 560 c call WriteField_p('pbarv',reshape(pbarv,(/iip1,jjm,llm/))) 561 c call WriteField_p('p',reshape(p,(/iip1,jmp1,llmp1/))) 562 c call WriteField_p('masse',reshape(masse,(/iip1,jmp1,llm/))) 563 c call WriteField_p('pk',reshape(pk,(/iip1,jmp1,llm/))) 564 cc$OMP END MASTER 559 565 560 566 c----------------------------------------------------------------------- … … 587 593 IF (offline) THEN 588 594 Cmaf stokage du flux de masse pour traceurs OFF-LINE 589 #undef CPP_IOIPSL 595 590 596 #ifdef CPP_IOIPSL 591 CALL fluxstokenc (pbaru,pbarv,masse,teta,phi,phis,597 CALL fluxstokenc_p(pbaru,pbarv,masse,teta,phi,phis, 592 598 . dtvr, itau) 593 599 #endif … … 662 668 c$OMP END MASTER 663 669 664 c$OMP BARRIER665 670 CALL pression_p ( ip1jmp1, ap, bp, ps, p ) 666 671 672 c$OMP BARRIER 673 667 674 CALL exner_hyb_p( ip1jmp1, ps, p,alpha,beta,pks, pk, pkf ) 675 c$OMP BARRIER 668 676 rdaym_ini = itau * dtvr / daysec 669 677 rdayvrai = rdaym_ini + day_ini … … 690 698 c$OMP MASTER 691 699 call VTb(VThallo) 700 c$OMP END MASTER 701 692 702 call SetTag(Request_physic,800) 693 703 … … 726 736 * jj_Nb_physic,2,2,Request_physic) 727 737 #endif 738 739 call SendRequest(Request_Physic) 740 c$OMP BARRIER 741 call WaitRequest(Request_Physic) 742 743 c$OMP BARRIER 744 c$OMP MASTER 728 745 call SetDistrib(jj_nb_Physic) 729 730 call SendRequest(Request_Physic)731 call WaitRequest(Request_Physic)732 733 746 call VTe(VThallo) 734 735 747 call VTb(VTphysiq) 736 748 c$OMP END MASTER … … 773 785 c$OMP MASTER 774 786 call SetDistrib(jj_nb_Physic_bis) 775 776 787 call VTb(VThallo) 788 c$OMP END MASTER 789 c$OMP BARRIER 777 790 778 791 call Register_Hallo(dufi,ip1jmp1,llm, … … 794 807 795 808 call SendRequest(Request_Physic) 809 c$OMP BARRIER 796 810 call WaitRequest(Request_Physic) 797 811 812 c$OMP BARRIER 813 c$OMP MASTER 798 814 call VTe(VThallo) 799 800 815 call SetDistrib(jj_nb_Physic) 801 816 c$OMP END MASTER 802 817 c$OMP BARRIER 803 ijb=ij_begin 818 819 ijb=ij_begin 804 820 if (.not. pole_nord) then 805 821 … … 842 858 c$OMP MASTER 843 859 call VTe(VTphysiq) 844 845 860 call VTb(VThallo) 861 c$OMP END MASTER 846 862 847 863 call SetTag(Request_physic,800) … … 878 894 879 895 call SendRequest(Request_Physic) 896 c$OMP BARRIER 880 897 call WaitRequest(Request_Physic) 881 898 882 call VTe(VThallo) 883 884 call SetDistrib(jj_Nb_caldyn) 899 c$OMP BARRIER 900 c$OMP MASTER 901 call VTe(VThallo) 902 call SetDistrib(jj_Nb_caldyn) 885 903 c$OMP END MASTER 886 904 c$OMP BARRIER … … 931 949 ENDIF 932 950 933 c$OMP BARRIER934 951 CALL pression_p ( ip1jmp1, ap, bp, ps, p ) 952 c$OMP BARRIER 953 954 935 955 CALL exner_hyb_p( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf ) 936 956 c$OMP BARRIER … … 956 976 957 977 c$OMP BARRIER 958 c$OMP MASTER 978 959 979 call Register_SwapFieldHallo(ucov,ucov,ip1jmp1,llm, 960 980 * jj_Nb_dissip,1,1,Request_dissip) … … 973 993 974 994 call SendRequest(Request_dissip) 995 c$OMP BARRIER 975 996 call WaitRequest(Request_dissip) 997 998 c$OMP BARRIER 999 c$OMP MASTER 976 1000 call SetDistrib(jj_Nb_dissip) 977 978 call VTe(VThallo) 979 1001 call VTe(VThallo) 980 1002 call VTb(VTdissipation) 981 982 1003 call start_timer(timer_dissip) 983 1004 c$OMP END MASTER … … 1016 1037 call suspend_timer(timer_dissip) 1017 1038 call VTb(VThallo) 1018 1039 c$OMP END MASTER 1019 1040 call Register_Hallo(ucov,ip1jmp1,llm,1,1,1,1,Request_Dissip) 1020 1041 call Register_Hallo(vcov,ip1jm,llm,1,1,1,1,Request_Dissip) 1021 1042 call SendRequest(Request_Dissip) 1043 c$OMP BARRIER 1022 1044 call WaitRequest(Request_Dissip) 1045 c$OMP MASTER 1023 1046 call VTe(VThallo) 1024 1047 call resume_timer(timer_dissip) … … 1115 1138 c$OMP MASTER 1116 1139 call VTe(VTdissipation) 1117 1118 1140 call stop_timer(timer_dissip) 1119 1120 1141 call VTb(VThallo) 1121 1142 c$OMP END MASTER 1122 1143 call Register_SwapField(ucov,ucov,ip1jmp1,llm, 1123 1144 * jj_Nb_caldyn,Request_dissip) … … 1136 1157 1137 1158 call SendRequest(Request_dissip) 1159 c$OMP BARRIER 1138 1160 call WaitRequest(Request_dissip) 1161 1162 c$OMP BARRIER 1163 c$OMP MASTER 1139 1164 call SetDistrib(jj_Nb_caldyn) 1140 1165 call VTe(VThallo) … … 1142 1167 print *,'fin dissipation' 1143 1168 c$OMP END MASTER 1169 c$OMP BARRIER 1144 1170 END IF 1145 1171 … … 1211 1237 call finalize_parallel 1212 1238 c$OMP END MASTER 1239 c$OMP BARRIER 1213 1240 RETURN 1214 1241 ENDIF … … 1244 1271 IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN 1245 1272 c$OMP BARRIER 1246 c$OMP MASTER1247 1273 IF(itau.EQ.itaufin) THEN 1248 1274 iav=1 … … 1250 1276 iav=0 1251 1277 ENDIF 1252 #ifdef CPP_IOIPSL 1253 call Register_Hallo(vcov,ip1jm,llm,1,0,0,1,TestRequest) 1254 call SendRequest(TestRequest) 1255 call WaitRequest(TestRequest) 1256 1257 CALL writedynav_p(histaveid, nqmx, itau,vcov , 1258 , ucov,teta,pk,phi,q,masse,ps,phis) 1278 c#ifdef CPP_IOIPSL 1279 c call Register_Hallo(vcov,ip1jm,llm,1,0,0,1,TestRequest) 1280 c call SendRequest(TestRequest) 1281 cc$OMP BARRIER 1282 c call WaitRequest(TestRequest) 1283 cc$OMP MASTER 1284 c CALL writedynav_p(histaveid, nqmx, itau,vcov , 1285 c , ucov,teta,pk,phi,q,masse,ps,phis) 1286 cc$OMP END MASTER 1259 1287 c call bilan_dyn_p(2,dtvr*iperiod,dtvr*day_step*periodav, 1260 1288 c , ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q) 1261 #endif 1262 c$OMP END MASTER 1289 c#endif 1263 1290 ENDIF 1264 1291 … … 1302 1329 enddo 1303 1330 1304 #ifdef CPP_IOIPSL1331 c#ifdef CPP_IOIPSL 1305 1332 1306 CALL writehist_p(histid,histvid, nqmx,itau,vcov,1307 s ucov,teta,phi,q,masse,ps,phis)1333 c CALL writehist_p(histid,histvid, nqmx,itau,vcov, 1334 c s ucov,teta,phi,q,masse,ps,phis) 1308 1335 c#else 1309 1336 c call Gather_Field(unat,ip1jmp1,llm,0) … … 1318 1345 c#include "write_grads_dyn.h" 1319 1346 c endif 1320 #endif1347 c#endif 1321 1348 c$OMP END MASTER 1322 1349 ENDIF … … 1402 1429 iav=0 1403 1430 ENDIF 1404 #ifdef CPP_IOIPSL 1405 c$OMP BARRIER 1406 c$OMP MASTER 1407 1408 call Register_Hallo(vcov,ip1jm,llm,1,0,0,1,TestRequest) 1409 call SendRequest(TestRequest) 1410 call WaitRequest(TestRequest) 1411 1412 CALL writedynav_p(histaveid, nqmx, itau,vcov , 1413 , ucov,teta,pk,phi,q,masse,ps,phis) 1431 c#ifdef CPP_IOIPSL 1432 cc$OMP BARRIER 1433 1434 c call Register_Hallo(vcov,ip1jm,llm,1,0,0,1,TestRequest) 1435 c call SendRequest(TestRequest) 1436 cc$OMP BARRIER 1437 c call WaitRequest(TestRequest) 1438 1439 cc$OMP MASTER 1440 c CALL writedynav_p(histaveid, nqmx, itau,vcov , 1441 c , ucov,teta,pk,phi,q,masse,ps,phis) 1414 1442 c call bilan_dyn_p (2,dtvr*iperiod,dtvr*day_step*periodav, 1415 1443 c , ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q) 1416 c $OMP END MASTER1417 #endif1444 cc$OMP END MASTER 1445 c#endif 1418 1446 ENDIF 1419 1447 … … 1451 1479 enddo 1452 1480 1453 #ifdef CPP_IOIPSL1454 1455 CALL writehist_p( histid, histvid, nqmx, itau,vcov ,1456 , ucov,teta,phi,q,masse,ps,phis)1481 c#ifdef CPP_IOIPSL 1482 1483 c CALL writehist_p( histid, histvid, nqmx, itau,vcov , 1484 c , ucov,teta,phi,q,masse,ps,phis) 1457 1485 c#else 1458 1486 c call Gather_Field(unat,ip1jmp1,llm,0) … … 1467 1495 c#include "write_grads_dyn.h" 1468 1496 c endif 1469 #endif1497 c#endif 1470 1498 1471 1499 c$OMP END MASTER
Note: See TracChangeset
for help on using the changeset viewer.