Ignore:
Timestamp:
May 3, 2005, 5:00:37 PM (19 years ago)
Author:
Laurent Fairhead
Message:

Modif pour compatibilité avec OASIS3 AC
LF

Location:
LMDZ4/branches/IPSL-CM4_IPCC_branch/libf/phylmd
Files:
1 deleted
3 edited

Legend:

Unmodified
Added
Removed

  • LMDZ4/branches/IPSL-CM4_IPCC_branch/libf/phylmd/inc_cpl.h

    r524 r628  
    1818      INTEGER jpread, jpwrit
    1919      PARAMETER (jpread=0, jpwrit=1)
     20#ifndef CPP_PSMILE
    2021      CHARACTER*8 cl_writ(jpmaxfld), cl_read(jpmaxfld)
    2122      CHARACTER*8 cl_f_writ(jpmaxfld), cl_f_read(jpmaxfld)
    2223      COMMON / comcpl / cl_writ, cl_read, cl_f_writ, cl_f_read
     24#endif
    2325!     -------------------------------------------------------------------

  • LMDZ4/branches/IPSL-CM4_IPCC_branch/libf/phylmd/interface_surf.F90

    r524 r628  
    12481248!   alb_ice      albedo de la glace
    12491249!
    1250 
     1250#ifdef CPP_PSMILE 
     1251  USE oasis
     1252  integer :: il_time_secs !time in seconds
     1253#endif
    12511254
    12521255! Parametres d'entree
    … …  
    13921395!
    13931396    idtime = int(dtime)
    1394     call inicma(npas , nexca, idtime,(jjm+1)*iim)
     1397#ifdef CPP_PSMILE
     1398    CALL inicma(iim, (jjm+1))
     1399#else
     1400   call inicma(npas , nexca, idtime,(jjm+1)*iim)
     1401#endif
    13951402
    13961403!
    … …  
    14971504    if (nisurf == is_oce .and. .not. cumul) then
    14981505      if (check) write(*,*)'rentree fromcpl, itime-1 = ',itime-1
     1506#ifdef CPP_PSMILE
     1507      il_time_secs=(itime-1)*dtime
     1508      CALL fromcpl(il_time_secs, iim, (jjm+1),                           &
     1509     &        read_sst, read_sic, read_sit, read_alb_sic)
     1510#else
    14991511      call fromcpl(itime-1,(jjm+1)*iim,                                  &
    15001512     &        read_sst, read_sic, read_sit, read_alb_sic)
     1513#endif
    15011514!
    15021515! sorties NETCDF des champs recus
    … …  
    16971710      CALL histsync(nidct)
    16981711! pas utile      IF (lafin) CALL histclo(nidct)
     1712#ifdef CPP_PSMILE
     1713      il_time_secs=(itime-1)*dtime
     1714
     1715      CALL intocpl(il_time_secs, iim, jjm+1, wri_sol_ice, wri_sol_sea, wri_nsol_ice,&
     1716      & wri_nsol_sea, wri_fder_ice, wri_evap_ice, wri_evap_sea, wri_rain, &
     1717      & wri_snow, wri_rcoa, wri_rriv, wri_calv, wri_tauxx, wri_tauyy,     &
     1718      & wri_tauzz, wri_tauxx, wri_tauyy, wri_tauzz,lafin )
     1719#else
    16991720      call intocpl(itime, (jjm+1)*iim, wri_sol_ice, wri_sol_sea, wri_nsol_ice,&
    17001721      & wri_nsol_sea, wri_fder_ice, wri_evap_ice, wri_evap_sea, wri_rain, &
    17011722      & wri_snow, wri_rcoa, wri_rriv, wri_calv, wri_tauxx, wri_tauyy,     &
    17021723      & wri_tauzz, wri_tauxx, wri_tauyy, wri_tauzz,lafin )
     1724#endif
    17031725!
    17041726      cpl_sols = 0.; cpl_nsol = 0.; cpl_rain = 0.; cpl_snow = 0.

  • LMDZ4/branches/IPSL-CM4_IPCC_branch/libf/phylmd/oasis.psmile

    r524 r628  
    2222   integer, dimension(jpfldo2a), save              :: in_var_id
    2323   integer, dimension(jpflda2o1+jpflda2o2), save  :: il_out_var_id
    24    CHARACTER (len=8), dimension(jpmaxfld), save   :: cl_writ, cl_read
     24   CHARACTER (len=8), dimension(jpmaxfld), public, save   :: cl_writ, cl_read
    2525   CHARACTER (len=8), dimension(jpmaxfld), save   :: cl_f_writ, cl_f_read
    2626
    … …  
    6060!
    6161   integer                                  :: comp_id
    62    integer                                  :: ierror
     62   integer                                  :: ierror, il_commlocal
    6363   integer                                  :: il_part_id
    6464   integer, dimension(:), allocatable       :: ig_paral
    65    integer, dimension(jpfldo2a)             :: in_var_id
    66    integer, dimension(jpflda2o1+jpflda2o2)  :: il_out_var_id
    6765   integer, dimension(2)                    :: il_var_nodims
    6866   integer, dimension(4)                    :: il_var_actual_shape
    … …  
    105103   ENDIF
    106104
     105! PSMILe attribution of local communicator
     106!
     107   call prism_get_localcomm_proto (il_commlocal, ierror)
    107108!
    108109! and domain decomposition
    … …  
    110111! monoproc case
    111112!
    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
    116119
    117120   call prism_def_partition_proto (il_part_id, ig_paral, ierror)
    … …  
    240243
    241244   call prism_get_proto(in_var_id(1), kt, sst, ierror)
    242    IF (ierror .ne. PRISM_Ok) THEN
     245   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Recvd .and. &
     246 &     ierror.ne.PRISM_FromRest &
     247 &     .and. ierror.ne.PRISM_Input .and. ierror.ne.PRISM_RecvOut &
     248 &     .and. ierror.ne.PRISM_FromRestOut) THEN
    243249     WRITE (nuout,*)  cl_read(1), kt   
    244250     abort_message=' Probleme dans prism_get_proto '
    … …  
    246252   endif
    247253   call prism_get_proto(in_var_id(2), kt, gla, ierror)
    248    IF (ierror .ne. PRISM_Ok) THEN
     254   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Recvd .and. &
     255 &     ierror.ne.PRISM_FromRest &
     256 &     .and. ierror.ne.PRISM_Input .and. ierror.ne.PRISM_RecvOut &
     257 &     .and. ierror.ne.PRISM_FromRestOut) THEN
    249258     WRITE (nuout,*)  cl_read(2), kt   
    250259     abort_message=' Probleme dans prism_get_proto '
    … …  
    252261   endif
    253262   call prism_get_proto(in_var_id(3), kt, albedo, ierror)
    254    IF (ierror .ne. PRISM_Ok) THEN
     263   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Recvd .and. &
     264 &     ierror.ne.PRISM_FromRest &
     265 &     .and. ierror.ne.PRISM_Input .and. ierror.ne.PRISM_RecvOut &
     266 &     .and. ierror.ne.PRISM_FromRestOut) THEN
    255267     WRITE (nuout,*)  cl_read(3), kt   
    256268     abort_message=' Probleme dans prism_get_proto '
    … …  
    258270   endif
    259271   call prism_get_proto(in_var_id(4), kt, tice, ierror)
    260    IF (ierror .ne. PRISM_Ok) THEN
     272   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Recvd .and. &
     273 &     ierror.ne.PRISM_FromRest &
     274 &     .and. ierror.ne.PRISM_Input .and. ierror.ne.PRISM_RecvOut &
     275 &     .and. ierror.ne.PRISM_FromRestOut) THEN
    261276     WRITE (nuout,*)  cl_read(4), kt   
    262277     abort_message=' Probleme dans prism_get_proto '
    … …  
    308323
    309324   call prism_put_proto(il_out_var_id(1), kt, fsolice, ierror)
    310    IF (ierror .ne. PRISM_Ok) THEN
     325   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
     326 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
     327 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
    311328     WRITE (nuout,*)  cl_writ(1), kt   
    312329     abort_message=' Probleme dans prism_put_proto '
    … …  
    314331   endif
    315332   call prism_put_proto(il_out_var_id(2), kt, fsolwat, ierror)
    316    IF (ierror .ne. PRISM_Ok) THEN
     333   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
     334 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
     335 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
    317336     WRITE (nuout,*)  cl_writ(2), kt   
    318337     abort_message=' Probleme dans prism_put_proto '
    … …  
    320339   endif
    321340   call prism_put_proto(il_out_var_id(3), kt, fnsolice, ierror)
    322    IF (ierror .ne. PRISM_Ok) THEN
     341   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
     342 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
     343 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
    323344     WRITE (nuout,*)  cl_writ(3), kt   
    324345     abort_message=' Probleme dans prism_put_proto '
    … …  
    326347   endif
    327348   call prism_put_proto(il_out_var_id(4), kt, fnsolwat, ierror)
    328    IF (ierror .ne. PRISM_Ok) THEN
     349   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
     350 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
     351 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
    329352     WRITE (nuout,*)  cl_writ(4), kt   
    330353     abort_message=' Probleme dans prism_put_proto '
    … …  
    332355   endif
    333356   call prism_put_proto(il_out_var_id(5), kt, fnsicedt, ierror)
    334    IF (ierror .ne. PRISM_Ok) THEN
     357   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
     358 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
     359 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
    335360     WRITE (nuout,*)  cl_writ(5), kt   
    336361     abort_message=' Probleme dans prism_put_proto '
    … …  
    338363   endif
    339364   call prism_put_proto(il_out_var_id(6), kt, evice, ierror)
    340    IF (ierror .ne. PRISM_Ok) THEN
     365   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
     366 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
     367 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
    341368     WRITE (nuout,*)  cl_writ(6), kt   
    342369     abort_message=' Probleme dans prism_put_proto '
    … …  
    344371   endif
    345372   call prism_put_proto(il_out_var_id(7), kt, evwat, ierror)
    346    IF (ierror .ne. PRISM_Ok) THEN
     373   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
     374 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
     375 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
    347376     WRITE (nuout,*)  cl_writ(7), kt   
    348377     abort_message=' Probleme dans prism_put_proto '
    … …  
    350379   endif
    351380   call prism_put_proto(il_out_var_id(8), kt, lpre, ierror)
    352    IF (ierror .ne. PRISM_Ok) THEN
     381   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
     382 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
     383 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
    353384     WRITE (nuout,*)  cl_writ(8), kt   
    354385     abort_message=' Probleme dans prism_put_proto '
    … …  
    356387   endif
    357388   call prism_put_proto(il_out_var_id(9), kt, spre, ierror)
    358    IF (ierror .ne. PRISM_Ok) THEN
     389   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
     390 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
     391 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
    359392     WRITE (nuout,*)  cl_writ(9), kt   
    360393     abort_message=' Probleme dans prism_put_proto '
    … …  
    362395   endif
    363396   call prism_put_proto(il_out_var_id(10), kt, dirunoff, ierror)
    364    IF (ierror .ne. PRISM_Ok) THEN
     397   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
     398 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
     399 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
    365400     WRITE (nuout,*)  cl_writ(10), kt   
    366401     abort_message=' Probleme dans prism_put_proto '
    … …  
    368403   endif
    369404   call prism_put_proto(il_out_var_id(11), kt, rivrunoff, ierror)
    370    IF (ierror .ne. PRISM_Ok) THEN
     405   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
     406 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
     407 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
    371408     WRITE (nuout,*)  cl_writ(11), kt   
    372409     abort_message=' Probleme dans prism_put_proto '
    … …  
    374411   endif
    375412   call prism_put_proto(il_out_var_id(12), kt, calving, ierror)
    376    IF (ierror .ne. PRISM_Ok) THEN
     413   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
     414 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
     415 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
    377416     WRITE (nuout,*)  cl_writ(12), kt   
    378417     abort_message=' Probleme dans prism_put_proto '
    … …  
    380419   endif
    381420   call prism_put_proto(il_out_var_id(13), kt, tauxx_u, ierror)
    382    IF (ierror .ne. PRISM_Ok) THEN
     421   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
     422 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
     423 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
    383424     WRITE (nuout,*)  cl_writ(13), kt   
    384425     abort_message=' Probleme dans prism_put_proto '
    … …  
    386427   endif
    387428   call prism_put_proto(il_out_var_id(14), kt, tauyy_u, ierror)
    388    IF (ierror .ne. PRISM_Ok) THEN
     429   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
     430 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
     431 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
    389432     WRITE (nuout,*)  cl_writ(14), kt   
    390433     abort_message=' Probleme dans prism_put_proto '
    … …  
    392435   endif
    393436   call prism_put_proto(il_out_var_id(15), kt, tauzz_u, ierror)
    394    IF (ierror .ne. PRISM_Ok) THEN
     437   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
     438 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
     439 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
    395440     WRITE (nuout,*)  cl_writ(15), kt   
    396441     abort_message=' Probleme dans prism_put_proto '
    … …  
    398443   endif
    399444   call prism_put_proto(il_out_var_id(16), kt, tauxx_v, ierror)
    400    IF (ierror .ne. PRISM_Ok) THEN
     445   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
     446 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
     447 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
    401448     WRITE (nuout,*)  cl_writ(16), kt   
    402449     abort_message=' Probleme dans prism_put_proto '
    … …  
    404451   endif
    405452   call prism_put_proto(il_out_var_id(17), kt, tauyy_v, ierror)
    406    IF (ierror .ne. PRISM_Ok) THEN
     453   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
     454 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
     455 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
    407456     WRITE (nuout,*)  cl_writ(17), kt   
    408457     abort_message=' Probleme dans prism_put_proto '
    … …  
    410459   endif
    411460   call prism_put_proto(il_out_var_id(18), kt, tauzz_v, ierror)
    412    IF (ierror .ne. PRISM_Ok) THEN
     461   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
     462 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
     463 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
    413464     WRITE (nuout,*)  cl_writ(18), kt   
    414465     abort_message=' Probleme dans prism_put_proto '
Note: See TracChangeset for help on using the changeset viewer.