Ignore:
Timestamp:
Aug 31, 2004, 1:09:09 PM (20 years ago)
Author:
lmdzadmin
Message:

Incorporation des modifications necessaires a l'utilisation de la librairie
Psmile/PRISM, et creation d'un tag IPSL-CM4_PSMILE, selon M.-E. Demory
LF

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/oasis.psmile

    r500 r544  
    2020   integer, dimension(jpfldo2a), save              :: in_var_id
    2121   integer, dimension(jpflda2o1+jpflda2o2), save  :: il_out_var_id
    22    CHARACTER (len=8), dimension(jpmaxfld), save   :: cl_writ, cl_read
     22   CHARACTER (len=8), dimension(jpmaxfld), public, save   :: cl_writ, cl_read
    2323   CHARACTER (len=8), dimension(jpmaxfld), save   :: cl_f_writ, cl_f_read
    2424
    25 CONTAINS
     25        CONTAINS
    2626
    2727!****
    … …  
    5858!
    5959   integer                                  :: comp_id
    60    integer                                  :: ierror
     60   integer                                  :: ierror, il_commlocal
    6161   integer                                  :: il_part_id
    6262   integer, dimension(:), allocatable       :: ig_paral
    63    integer, dimension(jpfldo2a)             :: in_var_id
    64    integer, dimension(jpflda2o1+jpflda2o2)  :: il_out_var_id
     63!   integer, dimension(jpfldo2a)             :: in_var_id
     64!   integer, dimension(jpflda2o1+jpflda2o2)  :: il_out_var_id
    6565   integer, dimension(2)                    :: il_var_nodims
    6666   integer, dimension(4)                    :: il_var_actual_shape
    … …  
    103103   ENDIF
    104104
     105! PSMILe attribution of local communicator
     106!
     107   call prism_get_localcomm_proto (il_commlocal, ierror)
    105108!
    106109! and domain decomposition
    … …  
    108111! monoproc case
    109112!
    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
    115123   call prism_def_partition_proto (il_part_id, ig_paral, ierror)
    116124   deallocate(ig_paral)
    … …  
    238246
    239247   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
    241252     WRITE (nuout,*)  cl_read(1), kt   
    242253     abort_message=' Probleme dans prism_get_proto '
    … …  
    244255   endif
    245256   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
    247261     WRITE (nuout,*)  cl_read(2), kt   
    248262     abort_message=' Probleme dans prism_get_proto '
    … …  
    250264   endif
    251265   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
    253270     WRITE (nuout,*)  cl_read(3), kt   
    254271     abort_message=' Probleme dans prism_get_proto '
    … …  
    256273   endif
    257274   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
    259279     WRITE (nuout,*)  cl_read(4), kt   
    260280     abort_message=' Probleme dans prism_get_proto '
    … …  
    306326
    307327   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
    309331     WRITE (nuout,*)  cl_writ(1), kt   
    310332     abort_message=' Probleme dans prism_put_proto '
    … …  
    312334   endif
    313335   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
    315339     WRITE (nuout,*)  cl_writ(2), kt   
    316340     abort_message=' Probleme dans prism_put_proto '
    … …  
    318342   endif
    319343   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
    321347     WRITE (nuout,*)  cl_writ(3), kt   
    322348     abort_message=' Probleme dans prism_put_proto '
    … …  
    324350   endif
    325351   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
    327355     WRITE (nuout,*)  cl_writ(4), kt   
    328356     abort_message=' Probleme dans prism_put_proto '
    … …  
    330358   endif
    331359   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
    333363     WRITE (nuout,*)  cl_writ(5), kt   
    334364     abort_message=' Probleme dans prism_put_proto '
    … …  
    336366   endif
    337367   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
    339371     WRITE (nuout,*)  cl_writ(6), kt   
    340372     abort_message=' Probleme dans prism_put_proto '
    … …  
    342374   endif
    343375   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
    345379     WRITE (nuout,*)  cl_writ(7), kt   
    346380     abort_message=' Probleme dans prism_put_proto '
    … …  
    348382   endif
    349383   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
    351387     WRITE (nuout,*)  cl_writ(8), kt   
    352388     abort_message=' Probleme dans prism_put_proto '
    … …  
    354390   endif
    355391   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
    357395     WRITE (nuout,*)  cl_writ(9), kt   
    358396     abort_message=' Probleme dans prism_put_proto '
    … …  
    360398   endif
    361399   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
    363403     WRITE (nuout,*)  cl_writ(10), kt   
    364404     abort_message=' Probleme dans prism_put_proto '
    … …  
    366406   endif
    367407   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
    369411     WRITE (nuout,*)  cl_writ(11), kt   
    370412     abort_message=' Probleme dans prism_put_proto '
    … …  
    372414   endif
    373415   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
    375419     WRITE (nuout,*)  cl_writ(12), kt   
    376420     abort_message=' Probleme dans prism_put_proto '
    … …  
    378422   endif
    379423   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
    381427     WRITE (nuout,*)  cl_writ(13), kt   
    382428     abort_message=' Probleme dans prism_put_proto '
    … …  
    384430   endif
    385431   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
    387435     WRITE (nuout,*)  cl_writ(14), kt   
    388436     abort_message=' Probleme dans prism_put_proto '
    … …  
    390438   endif
    391439   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
    393443     WRITE (nuout,*)  cl_writ(15), kt   
    394444     abort_message=' Probleme dans prism_put_proto '
    … …  
    396446   endif
    397447   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
    399451     WRITE (nuout,*)  cl_writ(16), kt   
    400452     abort_message=' Probleme dans prism_put_proto '
    … …  
    402454   endif
    403455   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
    405459     WRITE (nuout,*)  cl_writ(17), kt   
    406460     abort_message=' Probleme dans prism_put_proto '
    … …  
    408462   endif
    409463   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
    411467     WRITE (nuout,*)  cl_writ(18), kt   
    412468     abort_message=' Probleme dans prism_put_proto '
Note: See TracChangeset for help on using the changeset viewer.