Changeset 1279 for LMDZ4/trunk/libf/dyn3dpar/leapfrog_p.F
- Timestamp:
- Dec 10, 2009, 10:02:56 AM (15 years ago)
- Location:
- LMDZ4/trunk
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/trunk
- Property svn:mergeinfo changed
/LMDZ4/branches/LMDZ4-dev merged: 1150-1162,1164-1193,1195-1231,1234-1235,1237-1240,1242-1274,1276
- Property svn:mergeinfo changed
-
LMDZ4/trunk/libf/dyn3dpar/leapfrog_p.F
r1146 r1279 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 c … … 18 18 USE timer_filtre, ONLY : print_filtre_timer 19 19 USE infotrac 20 USE guide_p_mod, ONLY : guide_main 21 USE getparam 20 22 21 23 IMPLICIT NONE … … 118 120 c 119 121 INTEGER itau,itaufinp1,iav 120 INTEGER*4iday ! jour julien121 REAL time ! Heure de la journee en fraction d'1 jour122 ! INTEGER iday ! jour julien 123 REAL time 122 124 123 125 REAL SSUM … … 132 134 real time_step, t_wrt, t_ops 133 135 134 REAL rdayvrai,rdaym_ini 136 ! jD_cur: jour julien courant 137 ! jH_cur: heure julienne courante 138 REAL :: jD_cur, jH_cur 139 INTEGER :: an, mois, jour 140 REAL :: secondes 141 135 142 LOGICAL first,callinigrads 136 143 … … 160 167 character*80 abort_message 161 168 162 C Calendrier163 LOGICAL true_calendar164 PARAMETER (true_calendar = .false.)165 169 166 170 logical,PARAMETER :: dissip_conservative=.TRUE. … … 186 190 INTEGER :: iapptrac 187 191 INTEGER :: AdjustCount 188 INTEGER :: var_time192 ! INTEGER :: var_time 189 193 LOGICAL :: ok_start_timer=.FALSE. 190 194 LOGICAL, SAVE :: firstcall=.TRUE. … … 205 209 206 210 itau = 0 207 iday = day_ini+itau/day_step208 time = FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0209 IF(time.GT.1.) THEN210 time = time-1.211 iday = iday+1212 ENDIF211 ! iday = day_ini+itau/day_step 212 ! time = FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0 213 ! IF(time.GT.1.) THEN 214 ! time = time-1. 215 ! iday = iday+1 216 ! ENDIF 213 217 214 218 c Allocate variables depending on dynamic variable nqtot … … 239 243 1 CONTINUE 240 244 241 c$OMP MASTER 242 243 CALL barrier 244 245 c$OMP END MASTER 246 c$OMP BARRIER 245 jD_cur = jD_ref + day_ini - day_ref + int (itau * dtvr / daysec) 246 jH_cur = jH_ref + & 247 & (itau * dtvr / daysec - int(itau * dtvr / daysec)) 248 247 249 248 250 #ifdef CPP_IOIPSL 249 c$OMP MASTER 250 if (ok_guide.and.(itaufin-itau-1)*dtvr.gt.21600) then 251 call guide_pp(itau,ucov,vcov,teta,q,masse,ps) 252 else 253 IF(prt_level>9)WRITE(*,*)'attention on ne guide pas les ', 254 . '6 dernieres heures' 251 if (ok_guide) then 252 !$OMP MASTER 253 call guide_main(itau,ucov,vcov,teta,q,masse,ps) 254 !$OMP END MASTER 255 !$OMP BARRIER 255 256 endif 256 c$OMP END MASTER257 257 #endif 258 258 259 c 259 260 c IF( MOD( itau, 10* day_step ).EQ.0 ) THEN … … 545 546 call VTb(VTcaldyn) 546 547 c$OMP END MASTER 547 var_time=time+iday-day_ini548 ! var_time=time+iday-day_ini 548 549 549 550 c$OMP BARRIER 550 551 ! CALL FTRACE_REGION_BEGIN("caldyn") 552 time = jD_cur + jH_cur 551 553 CALL caldyn_p 552 554 $ ( itau,ucov,vcov,teta,ps,masse,pk,pkf,phis , 553 $ phi,conser,du,dv,dteta,dp,w, pbaru,pbarv, time +iday-day_ini)555 $ phi,conser,du,dv,dteta,dp,w, pbaru,pbarv, time ) 554 556 555 557 ! CALL FTRACE_REGION_END("caldyn") 558 556 559 c$OMP MASTER 557 560 call VTe(VTcaldyn) … … 560 563 cc$OMP BARRIER 561 564 cc$OMP MASTER 562 ccall WriteField_p('du',reshape(du,(/iip1,jmp1,llm/)))563 ccall WriteField_p('dv',reshape(dv,(/iip1,jjm,llm/)))564 ccall WriteField_p('dteta',reshape(dteta,(/iip1,jmp1,llm/)))565 ccall WriteField_p('dp',reshape(dp,(/iip1,jmp1/)))566 ccall WriteField_p('w',reshape(w,(/iip1,jmp1,llm/)))567 ccall WriteField_p('pbaru',reshape(pbaru,(/iip1,jmp1,llm/)))568 ccall WriteField_p('pbarv',reshape(pbarv,(/iip1,jjm,llm/)))569 ccall WriteField_p('p',reshape(p,(/iip1,jmp1,llmp1/)))570 ccall WriteField_p('masse',reshape(masse,(/iip1,jmp1,llm/)))571 ccall WriteField_p('pk',reshape(pk,(/iip1,jmp1,llm/)))565 ! call WriteField_p('du',reshape(du,(/iip1,jmp1,llm/))) 566 ! call WriteField_p('dv',reshape(dv,(/iip1,jjm,llm/))) 567 ! call WriteField_p('dteta',reshape(dteta,(/iip1,jmp1,llm/))) 568 ! call WriteField_p('dp',reshape(dp,(/iip1,jmp1/))) 569 ! call WriteField_p('w',reshape(w,(/iip1,jmp1,llm/))) 570 ! call WriteField_p('pbaru',reshape(pbaru,(/iip1,jmp1,llm/))) 571 ! call WriteField_p('pbarv',reshape(pbarv,(/iip1,jjm,llm/))) 572 ! call WriteField_p('p',reshape(p,(/iip1,jmp1,llmp1/))) 573 ! call WriteField_p('masse',reshape(masse,(/iip1,jmp1,llm/))) 574 ! call WriteField_p('pk',reshape(pk,(/iip1,jmp1,llm/))) 572 575 cc$OMP END MASTER 573 576 … … 681 684 CALL exner_hyb_p( ip1jmp1, ps, p,alpha,beta,pks, pk, pkf ) 682 685 c$OMP BARRIER 683 rdaym_ini = itau * dtvr / daysec 684 rdayvrai = rdaym_ini + day_ini 685 686 jD_cur = jD_ref + day_ini - day_ref 687 $ + int (itau * dtvr / daysec) 688 jH_cur = jH_ref + & 689 & (itau * dtvr / daysec - int(itau * dtvr / daysec)) 690 ! call ju2ymds(jD_cur+jH_cur, an, mois, jour, secondes) 686 691 687 692 c rajout debug … … 720 725 * jj_Nb_physic,2,2,Request_physic) 721 726 727 call Register_SwapFieldHallo(masse,masse,ip1jmp1,llm, 728 * jj_Nb_physic,1,2,Request_physic) 729 722 730 call Register_SwapFieldHallo(p,p,ip1jmp1,llmp1, 723 731 * jj_Nb_physic,2,2,Request_physic) … … 767 775 cc$OMP BARRIER 768 776 ! CALL FTRACE_REGION_BEGIN("calfis") 769 CALL calfis_p(lafin , rdayvrai,time,777 CALL calfis_p(lafin ,jD_cur, jH_cur, 770 778 $ ucov,vcov,teta,q,masse,ps,p,pk,phis,phi , 771 779 $ du,dv,dteta,dq, … … 861 869 c ------------------------------ 862 870 IF (ok_strato) THEN 863 CALL top_bound_p( vcov,ucov,teta, 871 CALL top_bound_p( vcov,ucov,teta,masse,dufi,dvfi,dtetafi) 864 872 ENDIF 865 873 … … 885 893 * jj_Nb_caldyn,Request_physic) 886 894 895 call Register_SwapField(masse,masse,ip1jmp1,llm, 896 * jj_Nb_caldyn,Request_physic) 897 887 898 call Register_SwapField(p,p,ip1jmp1,llmp1, 888 899 * jj_Nb_caldyn,Request_physic) … … 957 968 call Register_Hallo(vcov,ip1jm,llm,1,1,1,1,Request_Physic) 958 969 call SendRequest(Request_Physic) 970 c$OMP BARRIER 959 971 call WaitRequest(Request_Physic) 960 972 … … 1251 1263 print *, 'Temps CPU ecoule sur la parallelisation :',DiffCpuTime() 1252 1264 CALL print_filtre_timer 1265 call fin_getparam 1253 1266 call finalize_parallel 1254 1267 c$OMP END MASTER … … 1264 1277 IF(forward. OR. leapf) THEN 1265 1278 itau= itau + 1 1266 iday= day_ini+itau/day_step1267 time= FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_01268 IF(time.GT.1.) THEN1269 time = time-1.1270 iday = iday+11271 ENDIF1279 ! iday= day_ini+itau/day_step 1280 ! time= FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0 1281 ! IF(time.GT.1.) THEN 1282 ! time = time-1. 1283 ! iday = iday+1 1284 ! ENDIF 1272 1285 ENDIF 1273 1286 … … 1276 1289 1277 1290 c$OMP MASTER 1291 call fin_getparam 1278 1292 call finalize_parallel 1279 1293 c$OMP END MASTER … … 1301 1315 c$OMP BARRIER 1302 1316 c$OMP MASTER 1303 CALL writedynav_p(histaveid, itau,vcov ,1304 , ucov,teta,pk,phi,q,masse,ps,phis)1317 ! CALL writedynav_p(histaveid, itau,vcov , 1318 ! , ucov,teta,pk,phi,q,masse,ps,phis) 1305 1319 1306 1320 c ATTENTION!!! bilan_dyn_p ne marche probablement pas avec OpenMP … … 1353 1367 #ifdef CPP_IOIPSL 1354 1368 1355 CALL writehist_p(histid,histvid, itau,vcov,1356 & ucov,teta,phi,q,masse,ps,phis)1369 ! CALL writehist_p(histid,histvid, itau,vcov, 1370 ! & ucov,teta,phi,q,masse,ps,phis) 1357 1371 1358 1372 #endif … … 1380 1394 1381 1395 if (planet_type.eq."earth") then 1382 #ifdef CPP_EARTH1383 1396 ! Write an Earth-format restart file 1384 1397 CALL dynredem1_p("restart.nc",0.0, 1385 1398 & vcov,ucov,teta,q,masse,ps) 1386 1387 #endif1388 1399 endif ! of if (planet_type.eq."earth") 1389 1400 1390 CLOSE(99)1401 ! CLOSE(99) 1391 1402 c$OMP END MASTER 1392 1403 ENDIF ! of IF (itau.EQ.itaufin) … … 1433 1444 1434 1445 itau = itau + 1 1435 iday = day_ini+itau/day_step1436 time = FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_01437 1438 IF(time.GT.1.) THEN1439 time = time-1.1440 iday = iday+11441 ENDIF1446 ! iday = day_ini+itau/day_step 1447 ! time = FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0 1448 ! 1449 ! IF(time.GT.1.) THEN 1450 ! time = time-1. 1451 ! iday = iday+1 1452 ! ENDIF 1442 1453 1443 1454 forward = .FALSE. 1444 1455 IF( itau. EQ. itaufinp1 ) then 1445 1456 c$OMP MASTER 1457 call fin_getparam 1446 1458 call finalize_parallel 1447 1459 c$OMP END MASTER … … 1471 1483 c$OMP BARRIER 1472 1484 c$OMP MASTER 1473 CALL writedynav_p(histaveid, itau,vcov ,1474 , ucov,teta,pk,phi,q,masse,ps,phis)1485 ! CALL writedynav_p(histaveid, itau,vcov , 1486 ! , ucov,teta,pk,phi,q,masse,ps,phis) 1475 1487 CALL bilan_dyn_p(2,dtvr*iperiod,dtvr*day_step*periodav, 1476 1488 , ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q) … … 1516 1528 #ifdef CPP_IOIPSL 1517 1529 1518 CALL writehist_p(histid, histvid, itau,vcov ,1519 & ucov,teta,phi,q,masse,ps,phis)1530 ! CALL writehist_p(histid, histvid, itau,vcov , 1531 ! & ucov,teta,phi,q,masse,ps,phis) 1520 1532 #endif 1521 1533 ! For some Grads output (but does it work?) … … 1539 1551 IF(itau.EQ.itaufin) THEN 1540 1552 if (planet_type.eq."earth") then 1541 #ifdef CPP_EARTH1542 1553 c$OMP MASTER 1543 1554 CALL dynredem1_p("restart.nc",0.0, 1544 1555 . vcov,ucov,teta,q,masse,ps) 1545 1556 c$OMP END MASTER 1546 #endif1547 1557 endif ! of if (planet_type.eq."earth") 1548 1558 ENDIF ! of IF(itau.EQ.itaufin) … … 1555 1565 END IF ! of IF(.not.purmats) 1556 1566 c$OMP MASTER 1567 call fin_getparam 1557 1568 call finalize_parallel 1558 1569 c$OMP END MASTER
Note: See TracChangeset
for help on using the changeset viewer.