Changeset 626 for LMDZ4/trunk/libf
- Timestamp:
- Apr 29, 2005, 4:03:26 PM (20 years ago)
- Location:
- LMDZ4/trunk/libf/phylmd
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/trunk/libf/phylmd/inc_cpl.h
r524 r626 18 18 INTEGER jpread, jpwrit 19 19 PARAMETER (jpread=0, jpwrit=1) 20 #ifndef CPP_PSMILE 20 21 CHARACTER*8 cl_writ(jpmaxfld), cl_read(jpmaxfld) 21 22 CHARACTER*8 cl_f_writ(jpmaxfld), cl_f_read(jpmaxfld) 22 23 COMMON / comcpl / cl_writ, cl_read, cl_f_writ, cl_f_read 24 #endif 23 25 ! ------------------------------------------------------------------- -
LMDZ4/trunk/libf/phylmd/oasis.psmile
r524 r626 22 22 integer, dimension(jpfldo2a), save :: in_var_id 23 23 integer, dimension(jpflda2o1+jpflda2o2), save :: il_out_var_id 24 CHARACTER (len=8), dimension(jpmaxfld), save :: cl_writ, cl_read24 CHARACTER (len=8), dimension(jpmaxfld), public, save :: cl_writ, cl_read 25 25 CHARACTER (len=8), dimension(jpmaxfld), save :: cl_f_writ, cl_f_read 26 26 27 CONTAINS27 CONTAINS 28 28 29 29 !**** … … 60 60 ! 61 61 integer :: comp_id 62 integer :: ierror 62 integer :: ierror, il_commlocal 63 63 integer :: il_part_id 64 64 integer, dimension(:), allocatable :: ig_paral 65 integer, dimension(jpfldo2a) :: in_var_id66 integer, dimension(jpflda2o1+jpflda2o2) :: il_out_var_id67 65 integer, dimension(2) :: il_var_nodims 68 66 integer, dimension(4) :: il_var_actual_shape … … 105 103 ENDIF 106 104 105 ! PSMILe attribution of local communicator 106 ! 107 call prism_get_localcomm_proto (il_commlocal, ierror) 107 108 ! 108 109 ! and domain decomposition … … 110 111 ! monoproc case 111 112 ! 112 allocate(ig_paral(3)) 113 ig_paral(1) = 0 114 ig_paral(2) = 0 115 ig_paral(3) = im * jm 113 allocate(ig_paral(5)) 114 ig_paral (1) = 2 115 ig_paral (2) = 0 116 ig_paral (3) = im 117 ig_paral (4) = jm 118 ig_paral (5) = im 116 119 117 120 call prism_def_partition_proto (il_part_id, ig_paral, ierror) … … 131 134 ! must be the same as (1) of the field definition in namcouple: 132 135 ! 133 cl_writ(1)='COSHFICE' 134 cl_writ(2)='COSHFOCE' 135 cl_writ(3)='CONSFICE' 136 cl_writ(4)='CONSFOCE' 137 cl_writ(5)='CODFLXDT' 138 cl_writ(6)='COTFSICE' 139 cl_writ(7)='COTFSOCE' 140 cl_writ(8)='COTOLPSU' 141 cl_writ(9)='COTOSPSU' 142 cl_writ(10)='CORUNCOA' 143 cl_writ(11)='CORIVFLU' 144 cl_writ(12)='COCALVIN' 145 cl_writ(13)='COTAUXXU' 146 cl_writ(14)='COTAUYYU' 147 cl_writ(15)='COTAUZZU' 148 cl_writ(16)='COTAUXXV' 149 cl_writ(17)='COTAUYYV' 150 cl_writ(18)='COTAUZZV' 136 cl_writ(1)='COTAUXXU' 137 cl_writ(2)='COTAUYYU' 138 cl_writ(3)='COTAUZZU' 139 cl_writ(4)='COTAUXXV' 140 cl_writ(5)='COTAUYYV' 141 cl_writ(6)='COTAUZZV' 142 c -- LOOP 143 cl_writ(7)='COWINDSP' 144 c -- LOOP 145 cl_writ(8)='COSHFICE' 146 cl_writ(9)='COSHFOCE' 147 cl_writ(10)='CONSFICE' 148 cl_writ(11)='CONSFOCE' 149 cl_writ(12)='CODFLXDT' 150 cl_writ(13)='COTFSICE' 151 cl_writ(14)='COTFSOCE' 152 cl_writ(15)='COTOLPSU' 153 cl_writ(16)='COTOSPSU' 154 cl_writ(17)='CORUNCOA' 155 cl_writ(18)='CORIVFLU' 156 cl_writ(19)='COCALVIN' 151 157 ! 152 158 ! Define symbolic name for fields exchanged from coupler to atmosphere, … … 240 246 241 247 call prism_get_proto(in_var_id(1), kt, sst, ierror) 242 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 243 252 WRITE (nuout,*) cl_read(1), kt 244 253 abort_message=' Probleme dans prism_get_proto ' … … 246 255 endif 247 256 call prism_get_proto(in_var_id(2), kt, gla, ierror) 248 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 249 261 WRITE (nuout,*) cl_read(2), kt 250 262 abort_message=' Probleme dans prism_get_proto ' … … 252 264 endif 253 265 call prism_get_proto(in_var_id(3), kt, albedo, ierror) 254 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 255 270 WRITE (nuout,*) cl_read(3), kt 256 271 abort_message=' Probleme dans prism_get_proto ' … … 258 273 endif 259 274 call prism_get_proto(in_var_id(4), kt, tice, ierror) 260 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 261 279 WRITE (nuout,*) cl_read(4), kt 262 280 abort_message=' Probleme dans prism_get_proto ' … … 271 289 & fnsicedt, evice, evwat, lpre, spre, dirunoff, rivrunoff, & 272 290 & calving, tauxx_u, tauyy_u, tauzz_u, tauxx_v, tauyy_v, tauzz_v & 291 c -- LOOP 292 $ windsp, 293 c -- LOOP 273 294 & , last) 274 295 ! ====================================================================== … … 292 313 real, dimension(im, jm) :: tauxx_u, tauxx_v, tauyy_u 293 314 real, dimension(im, jm) :: tauyy_v, tauzz_u, tauzz_v 315 real, dimension(im, jm) :: windsp 294 316 logical :: last 295 317 ! … … 307 329 WRITE(nuout,*) 308 330 309 call prism_put_proto(il_out_var_id(1), kt, fsolice, ierror) 310 IF (ierror .ne. PRISM_Ok) THEN 331 call prism_put_proto(il_out_var_id(8), kt, fsolice, ierror) 332 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 333 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & 334 & ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN 335 WRITE (nuout,*) cl_writ(8), kt 336 abort_message=' Probleme dans prism_put_proto ' 337 call abort_gcm(modname,abort_message,1) 338 endif 339 call prism_put_proto(il_out_var_id(9), kt, fsolwat, ierror) 340 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 341 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & 342 & ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN 343 WRITE (nuout,*) cl_writ(9), kt 344 abort_message=' Probleme dans prism_put_proto ' 345 call abort_gcm(modname,abort_message,1) 346 endif 347 call prism_put_proto(il_out_var_id(10), kt, fnsolice, ierror) 348 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 349 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & 350 & ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN 351 WRITE (nuout,*) cl_writ(10), kt 352 abort_message=' Probleme dans prism_put_proto ' 353 call abort_gcm(modname,abort_message,1) 354 endif 355 call prism_put_proto(il_out_var_id(11), kt, fnsolwat, ierror) 356 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 357 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & 358 & ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN 359 WRITE (nuout,*) cl_writ(11), kt 360 abort_message=' Probleme dans prism_put_proto ' 361 call abort_gcm(modname,abort_message,1) 362 endif 363 call prism_put_proto(il_out_var_id(12), kt, fnsicedt, ierror) 364 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 365 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & 366 & ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN 367 WRITE (nuout,*) cl_writ(12), kt 368 abort_message=' Probleme dans prism_put_proto ' 369 call abort_gcm(modname,abort_message,1) 370 endif 371 call prism_put_proto(il_out_var_id(13), kt, evice, ierror) 372 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 373 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & 374 & ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN 375 WRITE (nuout,*) cl_writ(13), kt 376 abort_message=' Probleme dans prism_put_proto ' 377 call abort_gcm(modname,abort_message,1) 378 endif 379 call prism_put_proto(il_out_var_id(14), kt, evwat, ierror) 380 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 381 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & 382 & ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN 383 WRITE (nuout,*) cl_writ(14), kt 384 abort_message=' Probleme dans prism_put_proto ' 385 call abort_gcm(modname,abort_message,1) 386 endif 387 call prism_put_proto(il_out_var_id(15), kt, lpre, ierror) 388 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 389 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & 390 & ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN 391 WRITE (nuout,*) cl_writ(15), kt 392 abort_message=' Probleme dans prism_put_proto ' 393 call abort_gcm(modname,abort_message,1) 394 endif 395 call prism_put_proto(il_out_var_id(16), kt, spre, ierror) 396 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 397 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & 398 & ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN 399 WRITE (nuout,*) cl_writ(16), kt 400 abort_message=' Probleme dans prism_put_proto ' 401 call abort_gcm(modname,abort_message,1) 402 endif 403 call prism_put_proto(il_out_var_id(17), kt, dirunoff, ierror) 404 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 405 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & 406 & ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN 407 WRITE (nuout,*) cl_writ(17), kt 408 abort_message=' Probleme dans prism_put_proto ' 409 call abort_gcm(modname,abort_message,1) 410 endif 411 call prism_put_proto(il_out_var_id(18), kt, rivrunoff, ierror) 412 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 413 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & 414 & ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN 415 WRITE (nuout,*) cl_writ(18), kt 416 abort_message=' Probleme dans prism_put_proto ' 417 call abort_gcm(modname,abort_message,1) 418 endif 419 call prism_put_proto(il_out_var_id(19), kt, calving, ierror) 420 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 421 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & 422 & ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN 423 WRITE (nuout,*) cl_writ(19), kt 424 abort_message=' Probleme dans prism_put_proto ' 425 call abort_gcm(modname,abort_message,1) 426 endif 427 call prism_put_proto(il_out_var_id(1), kt, tauxx_u, ierror) 428 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 429 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & 430 & ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN 311 431 WRITE (nuout,*) cl_writ(1), kt 312 432 abort_message=' Probleme dans prism_put_proto ' 313 433 call abort_gcm(modname,abort_message,1) 314 434 endif 315 call prism_put_proto(il_out_var_id(2), kt, fsolwat, ierror) 316 IF (ierror .ne. PRISM_Ok) THEN 435 call prism_put_proto(il_out_var_id(2), kt, tauyy_u, ierror) 436 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 437 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & 438 & ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN 317 439 WRITE (nuout,*) cl_writ(2), kt 318 440 abort_message=' Probleme dans prism_put_proto ' 319 441 call abort_gcm(modname,abort_message,1) 320 442 endif 321 call prism_put_proto(il_out_var_id(3), kt, fnsolice, ierror) 322 IF (ierror .ne. PRISM_Ok) THEN 443 call prism_put_proto(il_out_var_id(3), kt, tauzz_u, ierror) 444 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 445 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & 446 & ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN 323 447 WRITE (nuout,*) cl_writ(3), kt 324 448 abort_message=' Probleme dans prism_put_proto ' 325 449 call abort_gcm(modname,abort_message,1) 326 450 endif 327 call prism_put_proto(il_out_var_id(4), kt, fnsolwat, ierror) 328 IF (ierror .ne. PRISM_Ok) THEN 451 call prism_put_proto(il_out_var_id(4), kt, tauxx_v, ierror) 452 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 453 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & 454 & ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN 329 455 WRITE (nuout,*) cl_writ(4), kt 330 456 abort_message=' Probleme dans prism_put_proto ' 331 457 call abort_gcm(modname,abort_message,1) 332 458 endif 333 call prism_put_proto(il_out_var_id(5), kt, fnsicedt, ierror) 334 IF (ierror .ne. PRISM_Ok) THEN 459 call prism_put_proto(il_out_var_id(5), kt, tauyy_v, ierror) 460 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 461 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & 462 & ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN 335 463 WRITE (nuout,*) cl_writ(5), kt 336 464 abort_message=' Probleme dans prism_put_proto ' 337 465 call abort_gcm(modname,abort_message,1) 338 466 endif 339 call prism_put_proto(il_out_var_id(6), kt, evice, ierror) 340 IF (ierror .ne. PRISM_Ok) THEN 467 call prism_put_proto(il_out_var_id(6), kt, tauzz_v, ierror) 468 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 469 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & 470 & ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN 341 471 WRITE (nuout,*) cl_writ(6), kt 342 472 abort_message=' Probleme dans prism_put_proto ' 343 473 call abort_gcm(modname,abort_message,1) 344 474 endif 345 call prism_put_proto(il_out_var_id(7), kt, evwat, ierror) 346 IF (ierror .ne. PRISM_Ok) THEN 475 call prism_put_proto(il_out_var_id(7), kt, windsp, ierror) 476 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 477 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & 478 & ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN 347 479 WRITE (nuout,*) cl_writ(7), kt 348 abort_message=' Probleme dans prism_put_proto '349 call abort_gcm(modname,abort_message,1)350 endif351 call prism_put_proto(il_out_var_id(8), kt, lpre, ierror)352 IF (ierror .ne. PRISM_Ok) THEN353 WRITE (nuout,*) cl_writ(8), kt354 abort_message=' Probleme dans prism_put_proto '355 call abort_gcm(modname,abort_message,1)356 endif357 call prism_put_proto(il_out_var_id(9), kt, spre, ierror)358 IF (ierror .ne. PRISM_Ok) THEN359 WRITE (nuout,*) cl_writ(9), kt360 abort_message=' Probleme dans prism_put_proto '361 call abort_gcm(modname,abort_message,1)362 endif363 call prism_put_proto(il_out_var_id(10), kt, dirunoff, ierror)364 IF (ierror .ne. PRISM_Ok) THEN365 WRITE (nuout,*) cl_writ(10), kt366 abort_message=' Probleme dans prism_put_proto '367 call abort_gcm(modname,abort_message,1)368 endif369 call prism_put_proto(il_out_var_id(11), kt, rivrunoff, ierror)370 IF (ierror .ne. PRISM_Ok) THEN371 WRITE (nuout,*) cl_writ(11), kt372 abort_message=' Probleme dans prism_put_proto '373 call abort_gcm(modname,abort_message,1)374 endif375 call prism_put_proto(il_out_var_id(12), kt, calving, ierror)376 IF (ierror .ne. PRISM_Ok) THEN377 WRITE (nuout,*) cl_writ(12), kt378 abort_message=' Probleme dans prism_put_proto '379 call abort_gcm(modname,abort_message,1)380 endif381 call prism_put_proto(il_out_var_id(13), kt, tauxx_u, ierror)382 IF (ierror .ne. PRISM_Ok) THEN383 WRITE (nuout,*) cl_writ(13), kt384 abort_message=' Probleme dans prism_put_proto '385 call abort_gcm(modname,abort_message,1)386 endif387 call prism_put_proto(il_out_var_id(14), kt, tauyy_u, ierror)388 IF (ierror .ne. PRISM_Ok) THEN389 WRITE (nuout,*) cl_writ(14), kt390 abort_message=' Probleme dans prism_put_proto '391 call abort_gcm(modname,abort_message,1)392 endif393 call prism_put_proto(il_out_var_id(15), kt, tauzz_u, ierror)394 IF (ierror .ne. PRISM_Ok) THEN395 WRITE (nuout,*) cl_writ(15), kt396 abort_message=' Probleme dans prism_put_proto '397 call abort_gcm(modname,abort_message,1)398 endif399 call prism_put_proto(il_out_var_id(16), kt, tauxx_v, ierror)400 IF (ierror .ne. PRISM_Ok) THEN401 WRITE (nuout,*) cl_writ(16), kt402 abort_message=' Probleme dans prism_put_proto '403 call abort_gcm(modname,abort_message,1)404 endif405 call prism_put_proto(il_out_var_id(17), kt, tauyy_v, ierror)406 IF (ierror .ne. PRISM_Ok) THEN407 WRITE (nuout,*) cl_writ(17), kt408 abort_message=' Probleme dans prism_put_proto '409 call abort_gcm(modname,abort_message,1)410 endif411 call prism_put_proto(il_out_var_id(18), kt, tauzz_v, ierror)412 IF (ierror .ne. PRISM_Ok) THEN413 WRITE (nuout,*) cl_writ(18), kt414 480 abort_message=' Probleme dans prism_put_proto ' 415 481 call abort_gcm(modname,abort_message,1) … … 419 485 call prism_terminate_proto(ierror) 420 486 IF (ierror .ne. PRISM_Ok) THEN 421 WRITE (nuout,*) cl_writ(18), kt422 487 abort_message=' Probleme dans prism_terminate_proto ' 423 488 call abort_gcm(modname,abort_message,1)
Note: See TracChangeset
for help on using the changeset viewer.