Changeset 949 for LMDZ4/trunk/libf
- Timestamp:
- Apr 16, 2008, 2:14:00 PM (17 years ago)
- Location:
- LMDZ4/trunk/libf/dyn3dpar
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/trunk/libf/dyn3dpar/abort_gcm.F
r774 r949 19 19 C ierr = severity of situation ( = 0 normal ) 20 20 21 character *20modname21 character (len=20) :: modname 22 22 integer ierr 23 character *80message23 character (len=80) :: message 24 24 25 25 write(lunout,*) 'in abort_gcm' -
LMDZ4/trunk/libf/dyn3dpar/description.h
r774 r949 2 2 ! $Header$ 3 3 ! 4 character *120descript4 character (len=120) :: descript 5 5 common /titre/descript -
LMDZ4/trunk/libf/dyn3dpar/gcm.F
r854 r949 77 77 78 78 REAL zdtvr 79 INTEGER nbetatmoy, nbetatdem,nbetat 79 c INTEGER nbetatmoy, nbetatdem,nbetat 80 INTEGER nbetatmoy, nbetatdem 80 81 81 82 c variables dynamiques … … 84 85 REAL q(ip1jmp1,llm,nqmx) ! champs advectes 85 86 REAL ps(ip1jmp1) ! pression au sol 86 REAL p (ip1jmp1,llmp1 ) ! pression aux interfac.des couches87 REAL pks(ip1jmp1) ! exner au sol88 REAL pk(ip1jmp1,llm) ! exner au milieu des couches89 REAL pkf(ip1jmp1,llm) ! exner filt.au milieu des couches87 c REAL p (ip1jmp1,llmp1 ) ! pression aux interfac.des couches 88 c REAL pks(ip1jmp1) ! exner au sol 89 c REAL pk(ip1jmp1,llm) ! exner au milieu des couches 90 c REAL pkf(ip1jmp1,llm) ! exner filt.au milieu des couches 90 91 REAL masse(ip1jmp1,llm) ! masse d'air 91 92 REAL phis(ip1jmp1) ! geopotentiel au sol 92 REAL phi(ip1jmp1,llm) ! geopotentiel93 REAL w(ip1jmp1,llm) ! vitesse verticale93 c REAL phi(ip1jmp1,llm) ! geopotentiel 94 c REAL w(ip1jmp1,llm) ! vitesse verticale 94 95 95 96 c variables dynamiques intermediaire pour le transport … … 101 102 102 103 LOGICAL lafin 103 INTEGER ij,iq,l,i,j 104 c INTEGER ij,iq,l,i,j 105 INTEGER i,j 104 106 105 107 106 108 real time_step, t_wrt, t_ops 107 109 108 REAL rdayvrai,rdaym_ini,rday_ecri109 LOGICAL first110 c REAL rdayvrai,rdaym_ini,rday_ecri 111 c LOGICAL first 110 112 111 113 LOGICAL call_iniphys 112 114 data call_iniphys/.true./ 113 115 114 REAL alpha(ip1jmp1,llm),beta(ip1jmp1,llm)116 c REAL alpha(ip1jmp1,llm),beta(ip1jmp1,llm) 115 117 c+jld variables test conservation energie 116 REAL ecin(ip1jmp1,llm),ecin0(ip1jmp1,llm)118 c REAL ecin(ip1jmp1,llm),ecin0(ip1jmp1,llm) 117 119 C Tendance de la temp. potentiel d (theta)/ d t due a la 118 120 C tansformation d'energie cinetique en energie thermique 119 121 C cree par la dissipation 120 REAL dhecdt(ip1jmp1,llm)121 REAL vcont(ip1jm,llm),ucont(ip1jmp1,llm)122 REAL d_h_vcol, d_qt, d_qw, d_ql, d_ec123 CHARACTER*15ztit122 c REAL dhecdt(ip1jmp1,llm) 123 c REAL vcont(ip1jm,llm),ucont(ip1jmp1,llm) 124 c REAL d_h_vcol, d_qt, d_qw, d_ql, d_ec 125 c CHARACTER (len=15) :: ztit 124 126 c-jld 125 127 126 128 127 character *80dynhist_file, dynhistave_file128 character *20modname129 character *80abort_message129 character (len=80) :: dynhist_file, dynhistave_file 130 character (len=20) ::modname 131 character (len=80) ::abort_message 130 132 131 133 C Calendrier -
LMDZ4/trunk/libf/dyn3dpar/leapfrog_p.F
r774 r949 221 221 c$OMP MASTER 222 222 OMP_CHUNK=5 223 c$OMP END MASTER 223 c$OMP END MASTER 224 224 c----------------------------------------------------------------------- 225 225 c On initialise la pression et la fonction d'Exner : … … 287 287 288 288 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 289 289 DO l=1,llm 290 290 ije=ij_end 291 291 ucovm1 (ijb:ije,l) = ucov (ijb:ije,l) 292 292 tetam1 (ijb:ije,l) = teta (ijb:ije,l) 293 293 massem1 (ijb:ije,l) = masse (ijb:ije,l) 294 294 finvmaold(ijb:ije,l)=masse(ijb:ije,l) 295 295 296 296 if (pole_sud) ije=ij_end-iip1 297 297 vcovm1(ijb:ije,l) = vcov (ijb:ije,l) … … 299 299 300 300 ENDDO 301 c$OMP ENDDO 301 c$OMP ENDDO 302 302 303 303 … … 376 376 IF (ok_start_timer) THEN 377 377 CALL InitTime 378 378 ok_start_timer=.FALSE. 379 379 ENDIF 380 380 c$OMP END MASTER … … 390 390 if (Verbose) then 391 391 392 393 394 395 392 print *,'*********************************' 393 print *,'****** TIMER CALDYN ******' 394 do i=0,mpi_size-1 395 print *,'proc',i,' : Nb Bandes :',jj_nb_caldyn(i), 396 396 & ' : temps moyen :', 397 397 & timer_average(jj_nb_caldyn(i),timer_caldyn,i), … … 400 400 401 401 print *,'*********************************' 402 403 404 402 print *,'****** TIMER VANLEER ******' 403 do i=0,mpi_size-1 404 print *,'proc',i,' : Nb Bandes :',jj_nb_vanleer(i), 405 405 & ' : temps moyen :', 406 406 & timer_average(jj_nb_vanleer(i),timer_vanleer,i), … … 409 409 410 410 print *,'*********************************' 411 412 413 411 print *,'****** TIMER DISSIP ******' 412 do i=0,mpi_size-1 413 print *,'proc',i,' : Nb Bandes :',jj_nb_dissip(i), 414 414 & ' : temps moyen :', 415 415 & timer_average(jj_nb_dissip(i),timer_dissip,i), … … 417 417 enddo 418 418 419 420 419 if (mpi_rank==0) call WriteBands 420 421 421 endif 422 422 423 423 call AdjustBands_caldyn 424 424 if (mpi_rank==0) call WriteBands 425 426 425 426 call Register_SwapFieldHallo(ucov,ucov,ip1jmp1,llm, 427 427 & jj_Nb_caldyn,0,0,TestRequest) 428 428 call Register_SwapFieldHallo(ucovm1,ucovm1,ip1jmp1,llm, … … 457 457 & jj_Nb_caldyn,0,0,TestRequest) 458 458 459 459 do j=1,nqmx 460 460 call Register_SwapFieldHallo(q(1,1,j),q(1,1,j),ip1jmp1,llm, 461 461 & jj_nb_caldyn,0,0,TestRequest) … … 466 466 call WaitRequest(TestRequest) 467 467 468 469 468 call AdjustBands_dissip 469 call AdjustBands_physic 470 470 471 471 endif … … 500 500 501 501 502 if (debug) then 502 if (debug) then 503 503 call WriteField_p('ucov',reshape(ucov,(/iip1,jmp1,llm/))) 504 504 call WriteField_p('vcov',reshape(vcov,(/iip1,jjm,llm/))) … … 506 506 call WriteField_p('ps',reshape(ps,(/iip1,jmp1/))) 507 507 call WriteField_p('masse',reshape(masse,(/iip1,jmp1,llm/))) 508 508 call WriteField_p('pk',reshape(pk,(/iip1,jmp1,llm/))) 509 509 call WriteField_p('pks',reshape(pks,(/iip1,jmp1/))) 510 510 call WriteField_p('pkf',reshape(pkf,(/iip1,jmp1,llm/))) … … 521 521 522 522 c$OMP MASTER 523 523 c print*,"Iteration No",True_itau 524 524 525 525 … … 659 659 c$OMP MASTER 660 660 call suspend_timer(timer_caldyn) 661 661 c print*,'Entree dans la physique : Iteration No ',true_itau 662 662 c$OMP END MASTER 663 663 … … 691 691 call VTb(VThallo) 692 692 call SetTag(Request_physic,800) 693 693 694 694 call Register_SwapFieldHallo(ucov,ucov,ip1jmp1,llm, 695 695 * jj_Nb_physic,2,2,Request_physic) … … 716 716 * jj_Nb_physic,2,2,Request_physic) 717 717 718 c 718 c call SetDistrib(jj_nb_vanleer) 719 719 do j=1,nqmx 720 720 … … 727 727 #endif 728 728 call SetDistrib(jj_nb_Physic) 729 729 730 730 call SendRequest(Request_Physic) 731 731 call WaitRequest(Request_Physic) 732 733 734 735 736 c$OMP END MASTER 737 c$OMP BARRIER 738 739 cc$OMP MASTER 732 733 call VTe(VThallo) 734 735 call VTb(VTphysiq) 736 c$OMP END MASTER 737 c$OMP BARRIER 738 739 cc$OMP MASTER 740 740 c call WriteField_p('ucovfi',reshape(ucov,(/iip1,jmp1,llm/))) 741 741 c call WriteField_p('vcovfi',reshape(vcov,(/iip1,jjm,llm/))) … … 745 745 cc$OMP END MASTER 746 746 cc$OMP BARRIER 747 747 748 748 CALL calfis_p( nq, lafin ,rdayvrai,time , 749 749 $ ucov,vcov,teta,q,masse,ps,p,pk,phis,phi , … … 768 768 dpfi_tmp(1:iip1) = dpfi(ijb:ijb+iim) 769 769 c$OMP END MASTER 770 771 772 c$OMP BARRIER 773 c$OMP MASTER 774 770 endif 771 772 c$OMP BARRIER 773 c$OMP MASTER 774 call SetDistrib(jj_nb_Physic_bis) 775 775 776 776 call VTb(VThallo) … … 800 800 call SetDistrib(jj_nb_Physic) 801 801 c$OMP END MASTER 802 c$OMP BARRIER 803 804 805 802 c$OMP BARRIER 803 ijb=ij_begin 804 if (.not. pole_nord) then 805 806 806 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 807 807 DO l=1,llm … … 818 818 dpfi(ijb:ijb+iim) = dpfi(ijb:ijb+iim)+ dpfi_tmp(1:iip1) 819 819 c$OMP END MASTER 820 820 821 821 endif 822 822 c$OMP BARRIER 823 cc$OMP MASTER 823 cc$OMP MASTER 824 824 c call WriteField_p('dufi',reshape(dufi,(/iip1,jmp1,llm/))) 825 825 c call WriteField_p('dvfi',reshape(dvfi,(/iip1,jjm,llm/))) … … 924 924 c$OMP MASTER 925 925 call resume_timer(timer_caldyn) 926 927 928 929 926 if (FirstPhysic) then 927 ok_start_timer=.TRUE. 928 FirstPhysic=.false. 929 endif 930 930 c$OMP END MASTER 931 931 ENDIF … … 947 947 c$OMP MASTER 948 948 call suspend_timer(timer_caldyn) 949 950 949 950 c print*,'Entree dans la dissipation : Iteration No ',true_itau 951 951 c calcul de l'energie cinetique avant dissipation 952 952 c print *,'Passage dans la dissipation' 953 953 954 954 call VTb(VThallo) … … 976 976 call SetDistrib(jj_Nb_dissip) 977 977 978 978 call VTe(VThallo) 979 979 980 980 call VTb(VTdissipation) 981 981 982 982 call start_timer(timer_dissip) 983 983 c$OMP END MASTER 984 984 c$OMP BARRIER … … 991 991 CALL dissip_p(vcov,ucov,teta,p,dvdis,dudis,dtetadis) 992 992 993 994 995 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 996 997 993 ijb=ij_begin 994 ije=ij_end 995 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 996 DO l=1,llm 997 ucov(ijb:ije,l)=ucov(ijb:ije,l)+dudis(ijb:ije,l) 998 998 ENDDO 999 c$OMP END DO NOWAIT 1000 1001 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1002 1003 999 c$OMP END DO NOWAIT 1000 if (pole_sud) ije=ije-iip1 1001 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1002 DO l=1,llm 1003 vcov(ijb:ije,l)=vcov(ijb:ije,l)+dvdis(ijb:ije,l) 1004 1004 ENDDO 1005 c$OMP END DO NOWAIT 1005 c$OMP END DO NOWAIT 1006 1006 1007 1007 c teta=teta+dtetadis … … 1015 1015 c$OMP MASTER 1016 1016 call suspend_timer(timer_dissip) 1017 1017 call VTb(VThallo) 1018 1018 1019 1019 call Register_Hallo(ucov,ip1jmp1,llm,1,1,1,1,Request_Dissip) … … 1024 1024 call resume_timer(timer_dissip) 1025 1025 c$OMP END MASTER 1026 c$OMP BARRIER 1026 c$OMP BARRIER 1027 1027 call covcont_p(llm,ucov,vcov,ucont,vcont) 1028 1028 call enercin_p(vcov,ucov,vcont,ucont,ecin) 1029 1029 1030 1031 1032 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1033 1034 1035 1036 1030 ijb=ij_begin 1031 ije=ij_end 1032 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1033 do l=1,llm 1034 do ij=ijb,ije 1035 dtetaecdt(ij,l)= (ecin0(ij,l)-ecin(ij,l))/ pk(ij,l) 1036 dtetadis(ij,l)=dtetadis(ij,l)+dtetaecdt(ij,l) 1037 1037 enddo 1038 1039 c$OMP END DO NOWAIT 1038 enddo 1039 c$OMP END DO NOWAIT 1040 1040 endif 1041 1041 1042 1042 ijb=ij_begin 1043 1043 ije=ij_end 1044 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1045 1046 1044 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1045 do l=1,llm 1046 do ij=ijb,ije 1047 1047 teta(ij,l)=teta(ij,l)+dtetadis(ij,l) 1048 1049 1050 c$OMP END DO NOWAIT 1048 enddo 1049 enddo 1050 c$OMP END DO NOWAIT 1051 1051 c------------------------------------------------------------------------ 1052 1052 … … 1117 1117 1118 1118 call stop_timer(timer_dissip) 1119 1119 1120 1120 call VTb(VThallo) 1121 1121 … … 1140 1140 call VTe(VThallo) 1141 1141 call resume_timer(timer_caldyn) 1142 1142 print *,'fin dissipation' 1143 1143 c$OMP END MASTER 1144 1144 END IF … … 1171 1171 1172 1172 print *,'*********************************' 1173 1174 1175 1173 print *,'****** TIMER CALDYN ******' 1174 do i=0,mpi_size-1 1175 print *,'proc',i,' : Nb Bandes :',jj_nb_caldyn(i), 1176 1176 & ' : temps moyen :', 1177 1177 & timer_average(jj_nb_caldyn(i),timer_caldyn,i) … … 1179 1179 1180 1180 print *,'*********************************' 1181 1182 1183 1181 print *,'****** TIMER VANLEER ******' 1182 do i=0,mpi_size-1 1183 print *,'proc',i,' : Nb Bandes :',jj_nb_vanleer(i), 1184 1184 & ' : temps moyen :', 1185 1185 & timer_average(jj_nb_vanleer(i),timer_vanleer,i) … … 1187 1187 1188 1188 print *,'*********************************' 1189 1190 1191 1189 print *,'****** TIMER DISSIP ******' 1190 do i=0,mpi_size-1 1191 print *,'proc',i,' : Nb Bandes :',jj_nb_dissip(i), 1192 1192 & ' : temps moyen :', 1193 1193 & timer_average(jj_nb_dissip(i),timer_dissip,i) 1194 1194 enddo 1195 1196 1197 1198 1199 1195 1196 print *,'*********************************' 1197 print *,'****** TIMER PHYSIC ******' 1198 do i=0,mpi_size-1 1199 print *,'proc',i,' : Nb Bandes :',jj_nb_physic(i), 1200 1200 & ' : temps moyen :', 1201 1201 & timer_average(jj_nb_physic(i),timer_physic,i) 1202 1202 enddo 1203 1203 1204 1204 endif 1205 1205 … … 1211 1211 call finalize_parallel 1212 1212 c$OMP END MASTER 1213 1213 RETURN 1214 1214 ENDIF 1215 1215 … … 1275 1275 CALL geopot_p ( ip1jmp1, teta , pk , pks, phis , phi ) 1276 1276 1277 cym 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1277 cym unat=0. 1278 1279 ijb=ij_begin 1280 ije=ij_end 1281 1282 if (pole_nord) then 1283 ijb=ij_begin+iip1 1284 unat(1:iip1,:)=0. 1285 endif 1286 1287 if (pole_sud) then 1288 ije=ij_end-iip1 1289 unat(ij_end-iip1+1:ij_end,:)=0. 1290 endif 1291 1292 1292 do l=1,llm 1293 1293 unat(ijb:ije,l)=ucov(ijb:ije,l)/cu(ijb:ije) 1294 1294 enddo 1295 1295 1296 1297 1298 1299 1300 1296 ijb=ij_begin 1297 ije=ij_end 1298 if (pole_sud) ije=ij_end-iip1 1299 1300 do l=1,llm 1301 1301 vnat(ijb:ije,l)=vcov(ijb:ije,l)/cv(ijb:ije) 1302 1302 enddo 1303 1303 1304 1304 #ifdef CPP_IOIPSL 1305 1305 … … 1387 1387 IF( itau. EQ. itaufinp1 ) then 1388 1388 c$OMP MASTER 1389 1389 call finalize_parallel 1390 1390 c$OMP END MASTER 1391 1391 abort_message = 'Simulation finished' … … 1426 1426 1427 1427 cym unat=0. 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1428 ijb=ij_begin 1429 ije=ij_end 1430 1431 if (pole_nord) then 1432 ijb=ij_begin+iip1 1433 unat(1:iip1,:)=0. 1434 endif 1435 1436 if (pole_sud) then 1437 ije=ij_end-iip1 1438 unat(ij_end-iip1+1:ij_end,:)=0. 1439 endif 1440 1441 1441 do l=1,llm 1442 1442 unat(ijb:ije,l)=ucov(ijb:ije,l)/cu(ijb:ije) 1443 1443 enddo 1444 1444 1445 1446 1447 1448 1449 1445 ijb=ij_begin 1446 ije=ij_end 1447 if (pole_sud) ije=ij_end-iip1 1448 1449 do l=1,llm 1450 1450 vnat(ijb:ije,l)=vcov(ijb:ije,l)/cv(ijb:ije) 1451 1451 enddo … … 1487 1487 call finalize_parallel 1488 1488 c$OMP END MASTER 1489 1489 RETURN 1490 1490 END
Note: See TracChangeset
for help on using the changeset viewer.