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

Location:
LMDZ.3.3/branches/rel-LF/libf/phylmd
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/interface_surf.F90

    r522 r544  
    12581258!   alb_ice      albedo de la glace
    12591259!
    1260 
     1260#ifdef CPP_PSMILE 
     1261  USE oasis
     1262#endif
    12611263
    12621264! Parametres d'entree
    12631265  integer, intent(IN) :: itime
     1266  integer :: il_time_secs                !time in seconds
    12641267  integer, intent(IN) :: iim, jjm
    12651268  real, intent(IN) :: dtime
    … …  
    14021405!
    14031406    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
    14061414!
    14071415! initialisation sorties netcdf
    … …  
    15071515    if (nisurf == is_oce .and. .not. cumul) then
    15081516      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
    15091523      call fromcpl(itime-1,(jjm+1)*iim,                                  &
    15101524     &        read_sst, read_sic, read_sit, read_alb_sic)
     1525#endif
     1526#endif
    15111527!
    15121528! sorties NETCDF des champs recus
    … …  
    17071723      CALL histsync(nidct)
    17081724! 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
    17091734      call intocpl(itime, (jjm+1)*iim, wri_sol_ice, wri_sol_sea, wri_nsol_ice,&
    17101735      & wri_nsol_sea, wri_fder_ice, wri_evap_ice, wri_evap_sea, wri_rain, &
    17111736      & wri_snow, wri_rcoa, wri_rriv, wri_calv, wri_tauxx, wri_tauyy,     &
    17121737      & wri_tauzz, wri_tauxx, wri_tauyy, wri_tauzz,lafin )
     1738#endif
     1739#endif
    17131740!
    17141741      cpl_sols = 0.; cpl_nsol = 0.; cpl_rain = 0.; cpl_snow = 0.

  • 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 '

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/physiq.F

    r523 r544  
    8585c      PARAMETER (npas=1440)
    8686c      PARAMETER (nexca=48)
    87       EXTERNAL fromcpl, intocpl, inicma
    8887c      ocean = type de modele ocean a utiliser: force, slab, couple
    8988      character*6 ocean
Note: See TracChangeset for help on using the changeset viewer.