Changeset 704 for LMDZ4/branches/V3_test/libf/phylmd/oasis.psmile
- Timestamp:
- Aug 17, 2006, 5:41:51 PM (18 years ago)
- File:
-
- 1 edited
-
LMDZ4/branches/V3_test/libf/phylmd/oasis.psmile (modified) (34 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/branches/V3_test/libf/phylmd/oasis.psmile
r626 r704 45 45 use mod_prism_proto 46 46 use mod_prism_def_partition_proto 47 47 use dimphy 48 48 implicit none 49 49 … … 94 94 ! Here we go: psmile initialisation 95 95 ! 96 call prism_init_comp_proto (comp_id, clmodnam, ierror) 97 98 IF (ierror .ne. PRISM_Ok) THEN 99 abort_message=' Probleme init dans prism_init_comp ' 100 call abort_gcm(modname,abort_message,1) 101 ELSE 102 WRITE(nuout,*) 'inicma : init psmile ok ' 103 ENDIF 104 105 ! PSMILe attribution of local communicator 106 ! 107 call prism_get_localcomm_proto (il_commlocal, ierror) 96 !ym call prism_init_comp_proto (comp_id, clmodnam, ierror) 97 !ym 98 !ym IF (ierror .ne. PRISM_Ok) THEN 99 !ym abort_message=' Probleme init dans prism_init_comp ' 100 !ym call abort_gcm(modname,abort_message,1) 101 !ym ELSE 102 !ym WRITE(nuout,*) 'inicma : init psmile ok ' 103 !ym ENDIF 104 call prism_get_localcomm_proto (il_commlocal, ierror) 108 105 ! 109 106 ! and domain decomposition … … 111 108 ! monoproc case 112 109 ! 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 119 110 allocate(ig_paral(3)) 111 !ym ig_paral(1) = 0 112 !ym ig_paral(2) = 0 113 !ym ig_paral(3) = im * jm 114 ig_paral(1) = 1 ! apple partition for // 115 ig_paral(2) = (jjphy_begin-1)*im+iiphy_begin-1 116 ig_paral(3) = (jjphy_end*im+iiphy_end)-(jjphy_begin*im+iiphy_begin)+1 117 if (phy_rank==phy_size-1) ig_paral(3)=ig_paral(3)+im-1 118 print *,phy_rank,'ig_paral--->',ig_paral(2),ig_paral(3) 119 120 ierror=PRISM_Ok 120 121 call prism_def_partition_proto (il_part_id, ig_paral, ierror) 121 122 deallocate(ig_paral) … … 140 141 cl_writ(5)='COTAUYYV' 141 142 cl_writ(6)='COTAUZZV' 142 c-- LOOP143 ! -- LOOP 143 144 cl_writ(7)='COWINDSP' 144 c-- LOOP145 ! -- LOOP 145 146 cl_writ(8)='COSHFICE' 146 147 cl_writ(9)='COSHFOCE' … … 218 219 use mod_prism_proto 219 220 use mod_prism_get_proto 220 221 use dimphy 221 222 IMPLICIT none 222 223 … … 225 226 ! 226 227 integer :: im, jm, kt 227 real, dimension(im ,jm) :: sst ! sea-surface-temperature228 real, dimension(im ,jm) :: gla ! sea-ice229 real, dimension(im ,jm) :: tice ! temp glace230 real, dimension(im ,jm) :: albedo ! albedo glace228 real, dimension(im*jm) :: sst ! sea-surface-temperature 229 real, dimension(im*jm) :: gla ! sea-ice 230 real, dimension(im*jm) :: tice ! temp glace 231 real, dimension(im*jm) :: albedo ! albedo glace 231 232 ! 232 233 ! local variables … … 236 237 character (len = 20),save :: modname = 'fromcpl' 237 238 character (len = 80) :: abort_message 239 integer :: istart,iend 238 240 ! 239 241 #include "param_cou.h" … … 245 247 CALL flush (nuout) 246 248 247 call prism_get_proto(in_var_id(1), kt, sst, ierror) 249 istart=iiphy_begin 250 if (phy_rank==phy_size-1) then 251 iend=(jjphy_end-jjphy_begin)*im+im 252 else 253 iend=(jjphy_end-jjphy_begin)*im+iiphy_end 254 endif 255 256 call prism_get_proto(in_var_id(1), kt, sst(istart:iend), ierror) 248 257 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Recvd .and. & 249 258 & ierror.ne.PRISM_FromRest & … … 254 263 call abort_gcm(modname,abort_message,1) 255 264 endif 256 call prism_get_proto(in_var_id(2), kt, gla , ierror)265 call prism_get_proto(in_var_id(2), kt, gla(istart:iend), ierror) 257 266 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Recvd .and. & 258 267 & ierror.ne.PRISM_FromRest & … … 263 272 call abort_gcm(modname,abort_message,1) 264 273 endif 265 call prism_get_proto(in_var_id(3), kt, albedo , ierror)274 call prism_get_proto(in_var_id(3), kt, albedo(istart:iend), ierror) 266 275 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Recvd .and. & 267 276 & ierror.ne.PRISM_FromRest & … … 272 281 call abort_gcm(modname,abort_message,1) 273 282 endif 274 call prism_get_proto(in_var_id(4), kt, tice , ierror)283 call prism_get_proto(in_var_id(4), kt, tice(istart:iend), ierror) 275 284 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Recvd .and. & 276 285 & ierror.ne.PRISM_FromRest & … … 288 297 SUBROUTINE intocpl(kt, im, jm, fsolice, fsolwat, fnsolice, fnsolwat, & 289 298 & fnsicedt, evice, evwat, lpre, spre, dirunoff, rivrunoff, & 290 & calving, tauxx_u, tauyy_u, tauzz_u, tauxx_v, tauyy_v, tauzz_v &291 c-- LOOP292 $ windsp,293 c-- LOOP294 & ,last)299 & calving, tauxx_u, tauyy_u, tauzz_u, tauxx_v, tauyy_v, tauzz_v, & 300 ! -- LOOP 301 & windsp, & 302 ! -- LOOP 303 & last) 295 304 ! ====================================================================== 296 305 ! L. Fairhead (09/2003) adapted From L.Z.X Li: this subroutine provides the … … 301 310 use mod_prism_proto 302 311 use mod_prism_put_proto 303 312 use dimphy 313 use write_field_phy 304 314 IMPLICIT NONE 305 315 … … 308 318 ! 309 319 integer :: kt, im, jm 310 real, dimension(im ,jm) :: fsolice, fsolwat, fnsolwat, fnsolice311 real, dimension(im ,jm) :: fnsicedt, evice, evwat, lpre, spre312 real, dimension(im ,jm) :: dirunoff, rivrunoff, calving313 real, dimension(im ,jm) :: tauxx_u, tauxx_v, tauyy_u314 real, dimension(im ,jm) :: tauyy_v, tauzz_u, tauzz_v315 real, dimension(im ,jm) :: windsp320 real, dimension(im* jm) :: fsolice, fsolwat, fnsolwat, fnsolice 321 real, dimension(im* jm) :: fnsicedt, evice, evwat, lpre, spre 322 real, dimension(im* jm) :: dirunoff, rivrunoff, calving 323 real, dimension(im* jm) :: tauxx_u, tauxx_v, tauyy_u 324 real, dimension(im* jm) :: tauyy_v, tauzz_u, tauzz_v 325 real, dimension(im*jm) :: windsp 316 326 logical :: last 327 logical :: checkout=.FALSE. 328 integer :: istart,iend 329 integer :: wstart,wend 317 330 ! 318 331 ! local … … 329 342 WRITE(nuout,*) 330 343 331 call prism_put_proto(il_out_var_id(8), kt, fsolice, ierror) 344 istart=iiphy_begin 345 if (phy_rank==phy_size-1) then 346 iend=(jjphy_end-jjphy_begin)*im+im 347 else 348 iend=(jjphy_end-jjphy_begin)*im+iiphy_end 349 endif 350 351 IF (checkout) THEN 352 wstart=istart 353 wend=iend 354 IF (phy_rank==0) wstart=istart+im-1 355 IF (phy_rank==phy_size-1) wend=iend-im+1 356 357 CALL writeField_phy("fsolice",fsolice(wstart:wend),1) 358 CALL writeField_phy("fsolwat",fsolwat(wstart:wend),1) 359 CALL writeField_phy("fnsolice",fnsolice(wstart:wend),1) 360 CALL writeField_phy("fnsolwat",fnsolwat(wstart:wend),1) 361 CALL writeField_phy("fnsicedt",fnsicedt(wstart:wend),1) 362 CALL writeField_phy("evice",evice(wstart:wend),1) 363 CALL writeField_phy("evwat",evwat(wstart:wend),1) 364 CALL writeField_phy("lpre",lpre(wstart:wend),1) 365 CALL writeField_phy("spre",spre(wstart:wend),1) 366 CALL writeField_phy("dirunoff",dirunoff(wstart:wend),1) 367 CALL writeField_phy("rivrunoff",rivrunoff(wstart:wend),1) 368 CALL writeField_phy("calving",calving(wstart:wend),1) 369 CALL writeField_phy("tauxx_u",tauxx_u(wstart:wend),1) 370 CALL writeField_phy("tauyy_u",tauyy_u(wstart:wend),1) 371 CALL writeField_phy("tauzz_u",tauzz_u(wstart:wend),1) 372 CALL writeField_phy("tauxx_v",tauxx_v(wstart:wend),1) 373 CALL writeField_phy("tauyy_v",tauyy_v(wstart:wend),1) 374 CALL writeField_phy("tauzz_v",tauzz_v(wstart:wend),1) 375 CALL writeField_phy("windsp",windsp(wstart:wend),1) 376 ENDIF 377 378 call prism_put_proto(il_out_var_id(8), kt, fsolice(istart:iend), ierror) 332 379 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 333 380 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & … … 337 384 call abort_gcm(modname,abort_message,1) 338 385 endif 339 call prism_put_proto(il_out_var_id(9), kt, fsolwat , ierror)386 call prism_put_proto(il_out_var_id(9), kt, fsolwat(istart:iend), ierror) 340 387 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 341 388 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & … … 345 392 call abort_gcm(modname,abort_message,1) 346 393 endif 347 call prism_put_proto(il_out_var_id(10), kt, fnsolice , ierror)394 call prism_put_proto(il_out_var_id(10), kt, fnsolice(istart:iend), ierror) 348 395 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 349 396 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & … … 353 400 call abort_gcm(modname,abort_message,1) 354 401 endif 355 call prism_put_proto(il_out_var_id(11), kt, fnsolwat , ierror)402 call prism_put_proto(il_out_var_id(11), kt, fnsolwat(istart:iend), ierror) 356 403 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 357 404 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & … … 361 408 call abort_gcm(modname,abort_message,1) 362 409 endif 363 call prism_put_proto(il_out_var_id(12), kt, fnsicedt , ierror)410 call prism_put_proto(il_out_var_id(12), kt, fnsicedt(istart:iend), ierror) 364 411 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 365 412 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & … … 369 416 call abort_gcm(modname,abort_message,1) 370 417 endif 371 call prism_put_proto(il_out_var_id(13), kt, evice , ierror)418 call prism_put_proto(il_out_var_id(13), kt, evice(istart:iend), ierror) 372 419 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 373 420 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & … … 377 424 call abort_gcm(modname,abort_message,1) 378 425 endif 379 call prism_put_proto(il_out_var_id(14), kt, evwat , ierror)426 call prism_put_proto(il_out_var_id(14), kt, evwat(istart:iend), ierror) 380 427 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 381 428 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & … … 385 432 call abort_gcm(modname,abort_message,1) 386 433 endif 387 call prism_put_proto(il_out_var_id(15), kt, lpre , ierror)434 call prism_put_proto(il_out_var_id(15), kt, lpre(istart:iend), ierror) 388 435 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 389 436 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & … … 393 440 call abort_gcm(modname,abort_message,1) 394 441 endif 395 call prism_put_proto(il_out_var_id(16), kt, spre , ierror)442 call prism_put_proto(il_out_var_id(16), kt, spre(istart:iend), ierror) 396 443 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 397 444 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & … … 401 448 call abort_gcm(modname,abort_message,1) 402 449 endif 403 call prism_put_proto(il_out_var_id(17), kt, dirunoff , ierror)450 call prism_put_proto(il_out_var_id(17), kt, dirunoff(istart:iend), ierror) 404 451 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 405 452 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & … … 409 456 call abort_gcm(modname,abort_message,1) 410 457 endif 411 call prism_put_proto(il_out_var_id(18), kt, rivrunoff , ierror)458 call prism_put_proto(il_out_var_id(18), kt, rivrunoff(istart:iend), ierror) 412 459 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 413 460 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & … … 417 464 call abort_gcm(modname,abort_message,1) 418 465 endif 419 call prism_put_proto(il_out_var_id(19), kt, calving , ierror)466 call prism_put_proto(il_out_var_id(19), kt, calving(istart:iend), ierror) 420 467 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 421 468 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & … … 425 472 call abort_gcm(modname,abort_message,1) 426 473 endif 427 call prism_put_proto(il_out_var_id(1), kt, tauxx_u , ierror)474 call prism_put_proto(il_out_var_id(1), kt, tauxx_u(istart:iend), ierror) 428 475 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 429 476 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & … … 433 480 call abort_gcm(modname,abort_message,1) 434 481 endif 435 call prism_put_proto(il_out_var_id(2), kt, tauyy_u , ierror)482 call prism_put_proto(il_out_var_id(2), kt, tauyy_u(istart:iend), ierror) 436 483 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 437 484 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & … … 441 488 call abort_gcm(modname,abort_message,1) 442 489 endif 443 call prism_put_proto(il_out_var_id(3), kt, tauzz_u , ierror)490 call prism_put_proto(il_out_var_id(3), kt, tauzz_u(istart:iend), ierror) 444 491 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 445 492 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & … … 449 496 call abort_gcm(modname,abort_message,1) 450 497 endif 451 call prism_put_proto(il_out_var_id(4), kt, tauxx_v , ierror)498 call prism_put_proto(il_out_var_id(4), kt, tauxx_v(istart:iend), ierror) 452 499 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 453 500 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & … … 457 504 call abort_gcm(modname,abort_message,1) 458 505 endif 459 call prism_put_proto(il_out_var_id(5), kt, tauyy_v , ierror)506 call prism_put_proto(il_out_var_id(5), kt, tauyy_v(istart:iend), ierror) 460 507 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 461 508 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & … … 465 512 call abort_gcm(modname,abort_message,1) 466 513 endif 467 call prism_put_proto(il_out_var_id(6), kt, tauzz_v , ierror)514 call prism_put_proto(il_out_var_id(6), kt, tauzz_v(istart:iend), ierror) 468 515 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 469 516 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & … … 473 520 call abort_gcm(modname,abort_message,1) 474 521 endif 475 call prism_put_proto(il_out_var_id(7), kt, windsp , ierror)522 call prism_put_proto(il_out_var_id(7), kt, windsp(istart:iend), ierror) 476 523 IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest & 477 524 & .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. & … … 483 530 484 531 if (last) then 485 call prism_terminate_proto(ierror) 486 IF (ierror .ne. PRISM_Ok) THEN 487 abort_message=' Probleme dans prism_terminate_proto ' 488 call abort_gcm(modname,abort_message,1) 489 endif 532 IF (monocpu) THEN 533 call prism_terminate_proto(ierror) 534 IF (ierror .ne. PRISM_Ok) THEN 535 abort_message=' Probleme dans prism_terminate_proto ' 536 call abort_gcm(modname,abort_message,1) 537 endif 538 ENDIF 490 539 endif 491 540
Note: See TracChangeset
for help on using the changeset viewer.
