- Timestamp:
- Aug 31, 2004, 1:09:09 PM (20 years ago)
- Location:
- LMDZ.3.3
- Files:
-
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ.3.3/branches/rel-LF/libf/phylmd/interface_surf.F90
r522 r544 1258 1258 ! alb_ice albedo de la glace 1259 1259 ! 1260 1260 #ifdef CPP_PSMILE 1261 USE oasis 1262 #endif 1261 1263 1262 1264 ! Parametres d'entree 1263 1265 integer, intent(IN) :: itime 1266 integer :: il_time_secs !time in seconds 1264 1267 integer, intent(IN) :: iim, jjm 1265 1268 real, intent(IN) :: dtime … … 1402 1405 ! 1403 1406 idtime = int(dtime) 1404 call inicma(npas , nexca, idtime,(jjm+1)*iim) 1405 1407 #ifdef CPP_COUPLE 1408 #ifdef CPP_PSMILE 1409 CALL inicma(iim, (jjm+1)) 1410 #else 1411 call inicma(npas , nexca, idtime,(jjm+1)*iim) 1412 #endif 1413 #endif 1406 1414 ! 1407 1415 ! initialisation sorties netcdf … … 1507 1515 if (nisurf == is_oce .and. .not. cumul) then 1508 1516 if (check) write(*,*)'rentree fromcpl, itime-1 = ',itime-1 1517 #ifdef CPP_COUPLE 1518 #ifdef CPP_PSMILE 1519 il_time_secs=(itime-1)*dtime 1520 CALL fromcpl(il_time_secs, iim, (jjm+1), & 1521 & read_sst, read_sic, read_sit, read_alb_sic) 1522 #else 1509 1523 call fromcpl(itime-1,(jjm+1)*iim, & 1510 1524 & read_sst, read_sic, read_sit, read_alb_sic) 1525 #endif 1526 #endif 1511 1527 ! 1512 1528 ! sorties NETCDF des champs recus … … 1707 1723 CALL histsync(nidct) 1708 1724 ! pas utile IF (lafin) CALL histclo(nidct) 1725 #ifdef CPP_COUPLE 1726 #ifdef CPP_PSMILE 1727 il_time_secs=(itime-1)*dtime 1728 1729 CALL intocpl(il_time_secs, iim, jjm+1, wri_sol_ice, wri_sol_sea, wri_nsol_ice,& 1730 & wri_nsol_sea, wri_fder_ice, wri_evap_ice, wri_evap_sea, wri_rain, & 1731 & wri_snow, wri_rcoa, wri_rriv, wri_calv, wri_tauxx, wri_tauyy, & 1732 & wri_tauzz, wri_tauxx, wri_tauyy, wri_tauzz,lafin ) 1733 #else 1709 1734 call intocpl(itime, (jjm+1)*iim, wri_sol_ice, wri_sol_sea, wri_nsol_ice,& 1710 1735 & wri_nsol_sea, wri_fder_ice, wri_evap_ice, wri_evap_sea, wri_rain, & 1711 1736 & wri_snow, wri_rcoa, wri_rriv, wri_calv, wri_tauxx, wri_tauyy, & 1712 1737 & wri_tauzz, wri_tauxx, wri_tauyy, wri_tauzz,lafin ) 1738 #endif 1739 #endif 1713 1740 ! 1714 1741 cpl_sols = 0.; cpl_nsol = 0.; cpl_rain = 0.; cpl_snow = 0. -
LMDZ.3.3/branches/rel-LF/libf/phylmd/oasis.psmile
r500 r544 20 20 integer, dimension(jpfldo2a), save :: in_var_id 21 21 integer, dimension(jpflda2o1+jpflda2o2), save :: il_out_var_id 22 CHARACTER (len=8), dimension(jpmaxfld), save :: cl_writ, cl_read22 CHARACTER (len=8), dimension(jpmaxfld), public, save :: cl_writ, cl_read 23 23 CHARACTER (len=8), dimension(jpmaxfld), save :: cl_f_writ, cl_f_read 24 24 25 CONTAINS25 CONTAINS 26 26 27 27 !**** … … 58 58 ! 59 59 integer :: comp_id 60 integer :: ierror 60 integer :: ierror, il_commlocal 61 61 integer :: il_part_id 62 62 integer, dimension(:), allocatable :: ig_paral 63 integer, dimension(jpfldo2a) :: in_var_id64 integer, dimension(jpflda2o1+jpflda2o2) :: il_out_var_id63 ! integer, dimension(jpfldo2a) :: in_var_id 64 ! integer, dimension(jpflda2o1+jpflda2o2) :: il_out_var_id 65 65 integer, dimension(2) :: il_var_nodims 66 66 integer, dimension(4) :: il_var_actual_shape … … 103 103 ENDIF 104 104 105 ! PSMILe attribution of local communicator 106 ! 107 call prism_get_localcomm_proto (il_commlocal, ierror) 105 108 ! 106 109 ! and domain decomposition … … 108 111 ! monoproc case 109 112 ! 110 allocate(ig_paral(3)) 111 ig_paral(1) = 0 112 ig_paral(2) = 0 113 ig_paral(3) = im * jm 114 113 ! allocate(ig_paral(3)) 114 ! ig_paral(1) = 0 115 ! ig_paral(2) = 0 116 ! ig_paral(3) = im * jm 117 allocate(ig_paral(5)) 118 ig_paral (1) = 2 119 ig_paral (2) = 0 120 ig_paral (3) = im 121 ig_paral (4) = jm 122 ig_paral (5) = im 115 123 call prism_def_partition_proto (il_part_id, ig_paral, ierror) 116 124 deallocate(ig_paral) … … 238 246 239 247 call prism_get_proto(in_var_id(1), kt, sst, ierror) 240 IF (ierror .ne. PRISM_Ok) THEN 248 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Recvd .and. & 249 & ierror.ne.PRISM_FromRest & 250 & .and. ierror.ne.PRISM_Input .and. ierror.ne.PRISM_RecvOut & 251 & .and. ierror.ne.PRISM_FromRestOut ) THEN 241 252 WRITE (nuout,*) cl_read(1), kt 242 253 abort_message=' Probleme dans prism_get_proto ' … … 244 255 endif 245 256 call prism_get_proto(in_var_id(2), kt, gla, ierror) 246 IF (ierror .ne. PRISM_Ok) THEN 257 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Recvd .and. & 258 & ierror.ne.PRISM_FromRest & 259 & .and. ierror.ne.PRISM_Input .and. ierror.ne.PRISM_RecvOut & 260 & .and. ierror.ne.PRISM_FromRestOut ) THEN 247 261 WRITE (nuout,*) cl_read(2), kt 248 262 abort_message=' Probleme dans prism_get_proto ' … … 250 264 endif 251 265 call prism_get_proto(in_var_id(3), kt, albedo, ierror) 252 IF (ierror .ne. PRISM_Ok) THEN 266 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Recvd .and. & 267 & ierror.ne.PRISM_FromRest & 268 & .and. ierror.ne.PRISM_Input .and. ierror.ne.PRISM_RecvOut & 269 & .and. ierror.ne.PRISM_FromRestOut ) THEN 253 270 WRITE (nuout,*) cl_read(3), kt 254 271 abort_message=' Probleme dans prism_get_proto ' … … 256 273 endif 257 274 call prism_get_proto(in_var_id(4), kt, tice, ierror) 258 IF (ierror .ne. PRISM_Ok) THEN 275 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Recvd .and. & 276 & ierror.ne.PRISM_FromRest & 277 & .and. ierror.ne.PRISM_Input .and. ierror.ne.PRISM_RecvOut & 278 & .and. ierror.ne.PRISM_FromRestOut ) THEN 259 279 WRITE (nuout,*) cl_read(4), kt 260 280 abort_message=' Probleme dans prism_get_proto ' … … 306 326 307 327 call prism_put_proto(il_out_var_id(1), kt, fsolice, ierror) 308 IF (ierror .ne. PRISM_Ok) THEN 328 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 329 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & 330 & ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut ) THEN 309 331 WRITE (nuout,*) cl_writ(1), kt 310 332 abort_message=' Probleme dans prism_put_proto ' … … 312 334 endif 313 335 call prism_put_proto(il_out_var_id(2), kt, fsolwat, ierror) 314 IF (ierror .ne. PRISM_Ok) THEN 336 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 337 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & 338 & ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut ) THEN 315 339 WRITE (nuout,*) cl_writ(2), kt 316 340 abort_message=' Probleme dans prism_put_proto ' … … 318 342 endif 319 343 call prism_put_proto(il_out_var_id(3), kt, fnsolice, ierror) 320 IF (ierror .ne. PRISM_Ok) THEN 344 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 345 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & 346 & ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut ) THEN 321 347 WRITE (nuout,*) cl_writ(3), kt 322 348 abort_message=' Probleme dans prism_put_proto ' … … 324 350 endif 325 351 call prism_put_proto(il_out_var_id(4), kt, fnsolwat, ierror) 326 IF (ierror .ne. PRISM_Ok) THEN 352 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 353 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & 354 & ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut ) THEN 327 355 WRITE (nuout,*) cl_writ(4), kt 328 356 abort_message=' Probleme dans prism_put_proto ' … … 330 358 endif 331 359 call prism_put_proto(il_out_var_id(5), kt, fnsicedt, ierror) 332 IF (ierror .ne. PRISM_Ok) THEN 360 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 361 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & 362 & ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut ) THEN 333 363 WRITE (nuout,*) cl_writ(5), kt 334 364 abort_message=' Probleme dans prism_put_proto ' … … 336 366 endif 337 367 call prism_put_proto(il_out_var_id(6), kt, evice, ierror) 338 IF (ierror .ne. PRISM_Ok) THEN 368 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 369 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & 370 & ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut ) THEN 339 371 WRITE (nuout,*) cl_writ(6), kt 340 372 abort_message=' Probleme dans prism_put_proto ' … … 342 374 endif 343 375 call prism_put_proto(il_out_var_id(7), kt, evwat, ierror) 344 IF (ierror .ne. PRISM_Ok) THEN 376 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 377 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & 378 & ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut ) THEN 345 379 WRITE (nuout,*) cl_writ(7), kt 346 380 abort_message=' Probleme dans prism_put_proto ' … … 348 382 endif 349 383 call prism_put_proto(il_out_var_id(8), kt, lpre, ierror) 350 IF (ierror .ne. PRISM_Ok) THEN 384 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 385 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & 386 & ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut ) THEN 351 387 WRITE (nuout,*) cl_writ(8), kt 352 388 abort_message=' Probleme dans prism_put_proto ' … … 354 390 endif 355 391 call prism_put_proto(il_out_var_id(9), kt, spre, ierror) 356 IF (ierror .ne. PRISM_Ok) THEN 392 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 393 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & 394 & ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut ) THEN 357 395 WRITE (nuout,*) cl_writ(9), kt 358 396 abort_message=' Probleme dans prism_put_proto ' … … 360 398 endif 361 399 call prism_put_proto(il_out_var_id(10), kt, dirunoff, ierror) 362 IF (ierror .ne. PRISM_Ok) THEN 400 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 401 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & 402 & ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut ) THEN 363 403 WRITE (nuout,*) cl_writ(10), kt 364 404 abort_message=' Probleme dans prism_put_proto ' … … 366 406 endif 367 407 call prism_put_proto(il_out_var_id(11), kt, rivrunoff, ierror) 368 IF (ierror .ne. PRISM_Ok) THEN 408 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 409 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & 410 & ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut ) THEN 369 411 WRITE (nuout,*) cl_writ(11), kt 370 412 abort_message=' Probleme dans prism_put_proto ' … … 372 414 endif 373 415 call prism_put_proto(il_out_var_id(12), kt, calving, ierror) 374 IF (ierror .ne. PRISM_Ok) THEN 416 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 417 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & 418 & ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut ) THEN 375 419 WRITE (nuout,*) cl_writ(12), kt 376 420 abort_message=' Probleme dans prism_put_proto ' … … 378 422 endif 379 423 call prism_put_proto(il_out_var_id(13), kt, tauxx_u, ierror) 380 IF (ierror .ne. PRISM_Ok) THEN 424 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 425 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & 426 & ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut ) THEN 381 427 WRITE (nuout,*) cl_writ(13), kt 382 428 abort_message=' Probleme dans prism_put_proto ' … … 384 430 endif 385 431 call prism_put_proto(il_out_var_id(14), kt, tauyy_u, ierror) 386 IF (ierror .ne. PRISM_Ok) THEN 432 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 433 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & 434 & ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut ) THEN 387 435 WRITE (nuout,*) cl_writ(14), kt 388 436 abort_message=' Probleme dans prism_put_proto ' … … 390 438 endif 391 439 call prism_put_proto(il_out_var_id(15), kt, tauzz_u, ierror) 392 IF (ierror .ne. PRISM_Ok) THEN 440 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 441 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & 442 & ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut ) THEN 393 443 WRITE (nuout,*) cl_writ(15), kt 394 444 abort_message=' Probleme dans prism_put_proto ' … … 396 446 endif 397 447 call prism_put_proto(il_out_var_id(16), kt, tauxx_v, ierror) 398 IF (ierror .ne. PRISM_Ok) THEN 448 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 449 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & 450 & ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut ) THEN 399 451 WRITE (nuout,*) cl_writ(16), kt 400 452 abort_message=' Probleme dans prism_put_proto ' … … 402 454 endif 403 455 call prism_put_proto(il_out_var_id(17), kt, tauyy_v, ierror) 404 IF (ierror .ne. PRISM_Ok) THEN 456 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 457 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & 458 & ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut ) THEN 405 459 WRITE (nuout,*) cl_writ(17), kt 406 460 abort_message=' Probleme dans prism_put_proto ' … … 408 462 endif 409 463 call prism_put_proto(il_out_var_id(18), kt, tauzz_v, ierror) 410 IF (ierror .ne. PRISM_Ok) THEN 464 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 465 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & 466 & ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut ) THEN 411 467 WRITE (nuout,*) cl_writ(18), kt 412 468 abort_message=' Probleme dans prism_put_proto ' -
LMDZ.3.3/branches/rel-LF/libf/phylmd/physiq.F
r523 r544 85 85 c PARAMETER (npas=1440) 86 86 c PARAMETER (nexca=48) 87 EXTERNAL fromcpl, intocpl, inicma88 87 c ocean = type de modele ocean a utiliser: force, slab, couple 89 88 character*6 ocean -
LMDZ.3.3/trunk/libf/dyn3d/bilan_dyn.F
r415 r544 110 110 character*10 znom(ntr,nQ) 111 111 character*20 znoml(ntr,nQ) 112 cvg>> 113 save znom, nom 114 cvg<< 112 115 character*10 zunites(ntr,nQ) 113 116 integer iave,itot,immc,itrs,istn -
LMDZ.3.3/trunk/libf/dyn3d/fxyhyper.F
r212 r544 114 114 WRITE(6,*) ' *********** ' 115 115 WRITE(6,18) 116 WRITE(6,3) dymin, dymax 116 cvg>> 117 WRITE(6,3) dymin 118 WRITE(6,4) dymax 119 cvg<< 120 cvg WRITE(6,3) dymin, dymax 117 121 WRITE(6,*) ' Si cette derniere est trop lache , modifiez les par 118 122 ,ametres grossism , tau , dzoom pour Y et repasser ! ' … … 122 126 WRITE(6,*) ' ************ ' 123 127 WRITE(6,18) 124 WRITE(6,3) dxmin, dxmax 128 cvg>> 129 WRITE(6,3) dxmin 130 WRITE(6,4) dxmax 131 cvg<< 132 cvg WRITE(6,3) dxmin, dxmax 125 133 WRITE(6,*) ' Si cette derniere est trop lache , modifiez les par 126 134 ,ametres grossism , tau , dzoom pour Y et repasser ! ' 127 135 WRITE(6,18) 128 136 c 137 cvg3 Format(1x, ' Au centre du zoom , la longueur de la maille est', 138 cvg , ' d environ ',f8.2 ,' degres ', 139 cvg , ' alors que la maille en dehors de la zone du zoom est d environ 140 cvg , ', f8.2,' degres ' ) 141 cvg>> 129 142 3 Format(1x, ' Au centre du zoom , la longueur de la maille est', 130 , ' d environ ',f8.2 ,' degres ', 131 , ' alors que la maille en dehors de la zone du zoom est d environ 132 , ', f8.2,' degres ' ) 143 , ' d environ ',f8.2 ,' degres ') 144 4 Format(1x, ' alors que la maille en dehors de la zone du zoom', 145 , ' est d environ ', f8.2,' degres ' ) 146 cvg<< 133 147 18 FORMAT(/) 134 148 -
LMDZ.3.3/trunk/libf/phylmd/inc_cpl.h
r13 r544 1 C 2 C -- inc_cpl.h 3 C ********** 4 C@ 5 C@ Contents : variables describing field restart file names 6 C@ -------- 7 C@ 8 C@ -- cl_write/cl_read : for fields to write/READ 9 C@ -- cl_f_write/cl_f_read : for fields to write/read 10 C@ 11 C ------------------------------------------------------------------- 12 C 1 ! 2 ! $Header$ 3 ! 4 ! -- inc_cpl.h 1998-04 5 ! ********** 6 !@ 7 !@ Contents : variables describing pipe and field names 8 !@ -------- 9 !@ 10 !@ -- cl_write : for fields to write 11 !@ 12 !@ -- cl_read : for fields to read 13 !@ 14 ! ------------------------------------------------------------------- 15 ! 16 INTEGER jpread, jpwrit 17 PARAMETER (jpread=0, jpwrit=1) 18 CHARACTER*8 cl_f_writ(jpmaxfld), cl_f_read(jpmaxfld) 19 #ifndef CPP_PSMILE 13 20 CHARACTER*8 cl_writ(jpmaxfld), cl_read(jpmaxfld) 14 CHARACTER*8 cl_f_writ(jpmaxfld), cl_f_read(jpmaxfld)15 21 COMMON / comcpl / cl_writ, cl_read, cl_f_writ, cl_f_read 16 C ------------------------------------------------------------------- 22 #endif 23 ! -------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.