Ignore:
Timestamp:
Dec 10, 2009, 10:02:56 AM (14 years ago)
Author:
Laurent Fairhead
Message:

Merged LMDZ4-dev branch changes r1241:1278 into the trunk
Running trunk and LMDZ4-dev in LMDZOR configuration on local
machine (sequential) and SX8 (4-proc) yields identical results
(restart and restartphy are identical binarily)
Log history from r1241 to r1278 is available by switching to
source:LMDZ4/branches/LMDZ4-dev-20091210

Location:
LMDZ4/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • LMDZ4/trunk

  • LMDZ4/trunk/libf/phylmd/oasis.F90

    r1146 r1279  
    2222 
    2323  IMPLICIT NONE
    24    
    25 ! Maximum number of fields exchanged between ocean and atmosphere
    26   INTEGER, PARAMETER  :: jpmaxfld=40
    27 ! Number of fields exchanged from atmosphere to ocean via flx.F
    28   INTEGER, PARAMETER  :: jpflda2o1=13
    29 ! Number of fields exchanged from atmosphere to ocean via tau.F
    30   INTEGER, PARAMETER  :: jpflda2o2=6
    31 ! Number of fields exchanged from ocean to atmosphere
    32   INTEGER  :: jpfldo2a
    33 
    34   CHARACTER (len=8), DIMENSION(jpmaxfld), PUBLIC, SAVE   :: cl_read
    35   !$OMP THREADPRIVATE(cl_read)
    36   CHARACTER (len=8), DIMENSION(jpmaxfld), PUBLIC, SAVE   :: cl_writ
    37   !$OMP THREADPRIVATE(cl_writ)
    38 
    39   INTEGER, DIMENSION(jpmaxfld), SAVE, PRIVATE            :: in_var_id
    40   !$OMP THREADPRIVATE(in_var_id)
    41   INTEGER, DIMENSION(jpflda2o1+jpflda2o2), SAVE, PRIVATE :: out_var_id
    42   !$OMP THREADPRIVATE(out_var_id)
    43 
    44   LOGICAL :: cpl_current
     24 
     25  ! Id for fields sent to ocean
     26  INTEGER, PARAMETER :: ids_tauxxu = 1
     27  INTEGER, PARAMETER :: ids_tauyyu = 2
     28  INTEGER, PARAMETER :: ids_tauzzu = 3
     29  INTEGER, PARAMETER :: ids_tauxxv = 4
     30  INTEGER, PARAMETER :: ids_tauyyv = 5
     31  INTEGER, PARAMETER :: ids_tauzzv = 6
     32  INTEGER, PARAMETER :: ids_windsp = 7
     33  INTEGER, PARAMETER :: ids_shfice = 8
     34  INTEGER, PARAMETER :: ids_shfoce = 9
     35  INTEGER, PARAMETER :: ids_shftot = 10
     36  INTEGER, PARAMETER :: ids_nsfice = 11
     37  INTEGER, PARAMETER :: ids_nsfoce = 12
     38  INTEGER, PARAMETER :: ids_nsftot = 13
     39  INTEGER, PARAMETER :: ids_dflxdt = 14
     40  INTEGER, PARAMETER :: ids_totrai = 15
     41  INTEGER, PARAMETER :: ids_totsno = 16
     42  INTEGER, PARAMETER :: ids_toteva = 17
     43  INTEGER, PARAMETER :: ids_icevap = 18
     44  INTEGER, PARAMETER :: ids_ocevap = 19
     45  INTEGER, PARAMETER :: ids_calvin = 20
     46  INTEGER, PARAMETER :: ids_liqrun = 21
     47  INTEGER, PARAMETER :: ids_runcoa = 22
     48  INTEGER, PARAMETER :: ids_rivflu = 23
     49  INTEGER, PARAMETER :: ids_atmco2 = 24
     50  INTEGER, PARAMETER :: ids_taumod = 25
     51  INTEGER, PARAMETER :: maxsend    = 25  ! Maximum number of fields to send
     52 
     53  ! Id for fields received from ocean
     54  INTEGER, PARAMETER :: idr_sisutw = 1
     55  INTEGER, PARAMETER :: idr_icecov = 2
     56  INTEGER, PARAMETER :: idr_icealw = 3
     57  INTEGER, PARAMETER :: idr_icetem = 4
     58  INTEGER, PARAMETER :: idr_curenx = 5
     59  INTEGER, PARAMETER :: idr_cureny = 6
     60  INTEGER, PARAMETER :: idr_curenz = 7
     61  INTEGER, PARAMETER :: idr_oceco2 = 8
     62  INTEGER, PARAMETER :: maxrecv    = 8  ! Maximum number of fields to receive
     63 
     64
     65  TYPE, PUBLIC ::   FLD_CPL            ! Type for coupling field information
     66     CHARACTER(len = 8) ::   name      ! Name of the coupling field   
     67     LOGICAL            ::   action    ! To be exchanged or not
     68     INTEGER            ::   nid       ! Id of the field
     69  END TYPE FLD_CPL
     70
     71  TYPE(FLD_CPL), DIMENSION(maxsend), SAVE, PUBLIC :: infosend   ! Information for sending coupling fields
     72  TYPE(FLD_CPL), DIMENSION(maxrecv), SAVE, PUBLIC :: inforecv   ! Information for receiving coupling fields
     73 
     74  LOGICAL,SAVE :: cpl_current
     75!$OMP THREADPRIVATE(cpl_current)
    4576
    4677#ifdef CPP_COUPLE
    … …  
    5889    USE IOIPSL
    5990    USE surface_data, ONLY : version_ocean
     91    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
     92
    6093    INCLUDE "dimensions.h"
     94    INCLUDE "iniprint.h"
    6195
    6296! Local variables
    … …  
    69103    INTEGER, DIMENSION(4)              :: il_var_actual_shape
    70104    INTEGER                            :: il_var_type
    71     INTEGER                            :: nuout = 6
    72105    INTEGER                            :: jf
    73106    CHARACTER (len = 6)                :: clmodnam
    … …  
    79112!        ---------------
    80113!************************************************************************************
    81     WRITE(nuout,*) ' '
    82     WRITE(nuout,*) ' '
    83     WRITE(nuout,*) ' ROUTINE INICMA'
    84     WRITE(nuout,*) ' **************'
    85     WRITE(nuout,*) ' '
    86     WRITE(nuout,*) ' '
     114    WRITE(lunout,*) ' '
     115    WRITE(lunout,*) ' '
     116    WRITE(lunout,*) ' ROUTINE INICMA'
     117    WRITE(lunout,*) ' **************'
     118    WRITE(lunout,*) ' '
     119    WRITE(lunout,*) ' '
    87120
    88121!
    … …  
    90123!
    91124    clmodnam = 'lmdz.x'       ! as in $NBMODEL in Cpl/Nam/namcouple.tmp
     125
    92126
    93127!************************************************************************************
    … …  
    100134!$OMP BARRIER
    101135    cpl_current = cpl_current_omp
    102     WRITE(nuout,*) 'Couple ocean currents, cpl_current = ',cpl_current
    103 
    104     IF (cpl_current) THEN
    105        jpfldo2a=7
    106     ELSE
    107        jpfldo2a=4
    108     END IF
     136    WRITE(lunout,*) 'Couple ocean currents, cpl_current = ',cpl_current
     137
     138!************************************************************************************
     139! Define coupling variables
     140!************************************************************************************
     141
     142! Atmospheric variables to send
     143
     144!$OMP MASTER
     145    infosend(:)%action = .FALSE.
     146
     147    infosend(ids_tauxxu)%action = .TRUE. ; infosend(ids_tauxxu)%name = 'COTAUXXU'
     148    infosend(ids_tauyyu)%action = .TRUE. ; infosend(ids_tauyyu)%name = 'COTAUYYU'
     149    infosend(ids_tauzzu)%action = .TRUE. ; infosend(ids_tauzzu)%name = 'COTAUZZU'
     150    infosend(ids_tauxxv)%action = .TRUE. ; infosend(ids_tauxxv)%name = 'COTAUXXV'
     151    infosend(ids_tauyyv)%action = .TRUE. ; infosend(ids_tauyyv)%name = 'COTAUYYV'
     152    infosend(ids_tauzzv)%action = .TRUE. ; infosend(ids_tauzzv)%name = 'COTAUZZV'
     153    infosend(ids_windsp)%action = .TRUE. ; infosend(ids_windsp)%name = 'COWINDSP'
     154    infosend(ids_shfice)%action = .TRUE. ; infosend(ids_shfice)%name = 'COSHFICE'
     155    infosend(ids_nsfice)%action = .TRUE. ; infosend(ids_nsfice)%name = 'CONSFICE'
     156    infosend(ids_dflxdt)%action = .TRUE. ; infosend(ids_dflxdt)%name = 'CODFLXDT'
     157    infosend(ids_calvin)%action = .TRUE. ; infosend(ids_calvin)%name = 'COCALVIN'
     158   
     159    IF (version_ocean=='nemo') THEN
     160        infosend(ids_shftot)%action = .TRUE. ; infosend(ids_shftot)%name = 'COQSRMIX'
     161        infosend(ids_nsftot)%action = .TRUE. ; infosend(ids_nsftot)%name = 'COQNSMIX'
     162        infosend(ids_totrai)%action = .TRUE. ; infosend(ids_totrai)%name = 'COTOTRAI'
     163        infosend(ids_totsno)%action = .TRUE. ; infosend(ids_totsno)%name = 'COTOTSNO'
     164        infosend(ids_toteva)%action = .TRUE. ; infosend(ids_toteva)%name = 'COTOTEVA'
     165        infosend(ids_icevap)%action = .TRUE. ; infosend(ids_icevap)%name = 'COICEVAP'
     166        infosend(ids_liqrun)%action = .TRUE. ; infosend(ids_liqrun)%name = 'COLIQRUN'
     167        infosend(ids_taumod)%action = .TRUE. ; infosend(ids_taumod)%name = 'COTAUMOD'
     168        IF (carbon_cycle_cpl) THEN
     169            infosend(ids_atmco2)%action = .TRUE. ; infosend(ids_atmco2)%name = 'COATMCO2'
     170        ENDIF
     171       
     172    ELSE IF (version_ocean=='opa8') THEN
     173        infosend(ids_shfoce)%action = .TRUE. ; infosend(ids_shfoce)%name = 'COSHFOCE'
     174        infosend(ids_nsfoce)%action = .TRUE. ; infosend(ids_nsfoce)%name = 'CONSFOCE'
     175        infosend(ids_icevap)%action = .TRUE. ; infosend(ids_icevap)%name = 'COTFSICE'
     176        infosend(ids_ocevap)%action = .TRUE. ; infosend(ids_ocevap)%name = 'COTFSOCE'
     177        infosend(ids_totrai)%action = .TRUE. ; infosend(ids_totrai)%name = 'COTOLPSU'
     178        infosend(ids_totsno)%action = .TRUE. ; infosend(ids_totsno)%name = 'COTOSPSU'
     179        infosend(ids_runcoa)%action = .TRUE. ; infosend(ids_runcoa)%name = 'CORUNCOA'
     180        infosend(ids_rivflu)%action = .TRUE. ; infosend(ids_rivflu)%name = 'CORIVFLU'
     181   ENDIF
     182       
     183! Oceanic variables to receive
     184
     185   inforecv(:)%action = .FALSE.
     186
     187   inforecv(idr_sisutw)%action = .TRUE. ; inforecv(idr_sisutw)%name = 'SISUTESW'
     188   inforecv(idr_icecov)%action = .TRUE. ; inforecv(idr_icecov)%name = 'SIICECOV'
     189   inforecv(idr_icealw)%action = .TRUE. ; inforecv(idr_icealw)%name = 'SIICEALW'
     190   inforecv(idr_icetem)%action = .TRUE. ; inforecv(idr_icetem)%name = 'SIICTEMW'
     191   
     192   IF (cpl_current ) THEN
     193       inforecv(idr_curenx)%action = .TRUE. ; inforecv(idr_curenx)%name = 'CURRENTX'
     194       inforecv(idr_cureny)%action = .TRUE. ; inforecv(idr_cureny)%name = 'CURRENTY'
     195       inforecv(idr_curenz)%action = .TRUE. ; inforecv(idr_curenz)%name = 'CURRENTZ'
     196   ENDIF
     197
     198   IF (carbon_cycle_cpl ) THEN
     199       inforecv(idr_oceco2)%action = .TRUE. ; inforecv(idr_oceco2)%name = 'SICO2FLX'
     200   ENDIF
     201
    109202!************************************************************************************
    110203! Here we go: psmile initialisation
    … …  
    117210          CALL abort_gcm(modname,abort_message,1)
    118211       ELSE
    119           WRITE(nuout,*) 'inicma : init psmile ok '
     212          WRITE(lunout,*) 'inicma : init psmile ok '
    120213       ENDIF
    121214    ENDIF
    … …  
    130223
    131224    IF (mpi_rank==mpi_size-1) ig_paral(3)=ig_paral(3)+iim-1
    132     WRITE(nuout,*) mpi_rank,'ig_paral--->',ig_paral(2),ig_paral(3)
     225    WRITE(lunout,*) mpi_rank,'ig_paral--->',ig_paral(2),ig_paral(3)
    133226   
    134227    ierror=PRISM_Ok
    … …  
    139232       CALL abort_gcm(modname,abort_message,1)
    140233    ELSE
    141        WRITE(nuout,*) 'inicma : decomposition domaine psmile ok '
    142     ENDIF
    143 
    144 !************************************************************************************
    145 ! Field Declarations
    146 !************************************************************************************
    147 !     Define symbolic name for fields exchanged from atmos to coupler,
    148 !         must be the same as (1) of the field definition in namcouple:
    149 !
    150 !   Initialization
    151     cl_writ(:)='NOFLDATM'
    152 
    153     cl_writ(1)='COTAUXXU'
    154     cl_writ(2)='COTAUYYU'
    155     cl_writ(3)='COTAUZZU'
    156     cl_writ(4)='COTAUXXV'
    157     cl_writ(5)='COTAUYYV'
    158     cl_writ(6)='COTAUZZV'
    159     cl_writ(7)='COWINDSP'
    160     cl_writ(8)='COSHFICE'
    161     cl_writ(10)='CONSFICE'
    162     cl_writ(12)='CODFLXDT'
    163 
    164     IF (version_ocean=='nemo') THEN
    165       cl_writ(9)='COQSRMIX'
    166       cl_writ(11)='COQNSMIX'
    167       cl_writ(13)='COTOTRAI'
    168       cl_writ(14)='COTOTSNO'
    169       cl_writ(15)='COTOTEVA'
    170       cl_writ(16)='COICEVAP'
    171       cl_writ(17)='COCALVIN'
    172       cl_writ(18)='COLIQRUN'
    173     ELSE IF (version_ocean=='opa8') THEN
    174        cl_writ(9)='COSHFOCE'
    175        cl_writ(11)='CONSFOCE'
    176        cl_writ(13)='COTFSICE'
    177        cl_writ(14)='COTFSOCE'
    178        cl_writ(15)='COTOLPSU'
    179        cl_writ(16)='COTOSPSU'
    180        cl_writ(17)='CORUNCOA'
    181        cl_writ(18)='CORIVFLU'
    182        cl_writ(19)='COCALVIN'
    183     ENDIF
    184 
    185 !
    186 !     Define symbolic name for fields exchanged from coupler to atmosphere,
    187 !         must be the same as (2) of the field definition in namcouple:
    188 !
    189 !   Initialization
    190     cl_read(:)='NOFLDATM'
    191 
    192     cl_read(1)='SISUTESW'
    193     cl_read(2)='SIICECOV'
    194     cl_read(3)='SIICEALW'
    195     cl_read(4)='SIICTEMW'
    196 
    197     IF (cpl_current) THEN
    198        cl_read(5)='CURRENTX'
    199        cl_read(6)='CURRENTY'
    200        cl_read(7)='CURRENTZ'
    201     END IF
     234       WRITE(lunout,*) 'inicma : decomposition domaine psmile ok '
     235    ENDIF
    202236
    203237    il_var_nodims(1) = 2
    … …  
    212246
    213247!************************************************************************************
    214 ! Oceanic Fields
    215 !************************************************************************************
    216     DO jf=1, jpfldo2a
    217        CALL prism_def_var_proto(in_var_id(jf), cl_read(jf), il_part_id, &
    218             il_var_nodims, PRISM_In, il_var_actual_shape, il_var_type, &
    219             ierror)
    220        IF (ierror .NE. PRISM_Ok) THEN
    221           abort_message=' Probleme init dans prism_def_var_proto '
    222           CALL abort_gcm(modname,abort_message,1)
     248! Oceanic Fields to receive
     249! Loop over all possible variables
     250!************************************************************************************
     251    DO jf=1, maxrecv
     252       IF (inforecv(jf)%action) THEN
     253          CALL prism_def_var_proto(inforecv(jf)%nid, inforecv(jf)%name, il_part_id, &
     254               il_var_nodims, PRISM_In, il_var_actual_shape, il_var_type, &
     255               ierror)
     256          IF (ierror .NE. PRISM_Ok) THEN
     257             WRITE(lunout,*) 'inicma : Problem with prism_def_var_proto for field : ',&
     258                  inforecv(jf)%name
     259             abort_message=' Problem in call to prism_def_var_proto for fields to receive'
     260             CALL abort_gcm(modname,abort_message,1)
     261          ENDIF
    223262       ENDIF
    224263    END DO
    225 
    226 !************************************************************************************
    227 ! Atmospheric Fields
    228 !************************************************************************************
    229     DO jf=1, jpflda2o1+jpflda2o2
    230        CALL prism_def_var_proto(out_var_id(jf), cl_writ(jf), il_part_id, &
    231             il_var_nodims, PRISM_Out, il_var_actual_shape, il_var_type, &
    232             ierror)
    233        IF (ierror .NE. PRISM_Ok) THEN
    234           abort_message=' Probleme init dans prism_def_var_proto '
    235           CALL abort_gcm(modname,abort_message,1)
     264   
     265!************************************************************************************
     266! Atmospheric Fields to send
     267! Loop over all possible variables
     268!************************************************************************************
     269    DO jf=1,maxsend
     270       IF (infosend(jf)%action) THEN
     271          CALL prism_def_var_proto(infosend(jf)%nid, infosend(jf)%name, il_part_id, &
     272               il_var_nodims, PRISM_Out, il_var_actual_shape, il_var_type, &
     273               ierror)
     274          IF (ierror .NE. PRISM_Ok) THEN
     275             WRITE(lunout,*) 'inicma : Problem with prism_def_var_proto for field : ',&
     276                  infosend(jf)%name
     277             abort_message=' Problem in call to prism_def_var_proto for fields to send'
     278             CALL abort_gcm(modname,abort_message,1)
     279          ENDIF
    236280       ENDIF
    237281    END DO
    238 
     282   
    239283!************************************************************************************
    240284! End definition
    … …  
    242286    CALL prism_enddef_proto(ierror)
    243287    IF (ierror .NE. PRISM_Ok) THEN
    244        abort_message=' Probleme init dans prism_ endef_proto'
     288       abort_message=' Problem in call to prism_endef_proto'
    245289       CALL abort_gcm(modname,abort_message,1)
    246290    ELSE
    247        WRITE(nuout,*) 'inicma : endef psmile ok '
    248     ENDIF
     291       WRITE(lunout,*) 'inicma : endef psmile ok '
     292    ENDIF
     293
     294!$OMP END MASTER
    249295   
    250296  END SUBROUTINE inicma
    … …  
    261307!
    262308    INCLUDE "dimensions.h"
     309    INCLUDE "iniprint.h"
    263310! Input arguments
    264311!************************************************************************************
    … …  
    267314! Output arguments
    268315!************************************************************************************
    269     REAL, DIMENSION(iim, jj_nb,jpfldo2a), INTENT(OUT) :: tab_get
     316    REAL, DIMENSION(iim, jj_nb,maxrecv), INTENT(OUT) :: tab_get
    270317
    271318! Local variables
    272319!************************************************************************************
    273     INTEGER                       :: nuout  = 6             ! listing output unit
    274320    INTEGER                       :: ierror, i
    275321    INTEGER                       :: istart,iend
    … …  
    279325
    280326!************************************************************************************
    281     WRITE (nuout,*) ' '
    282     WRITE (nuout,*) 'Fromcpl: Reading fields from CPL, ktime=',ktime
    283     WRITE (nuout,*) ' '
     327    WRITE (lunout,*) ' '
     328    WRITE (lunout,*) 'Fromcpl: Reading fields from CPL, ktime=',ktime
     329    WRITE (lunout,*) ' '
    284330   
    285331    istart=ii_begin
    … …  
    290336    ENDIF
    291337   
    292     DO i = 1, jpfldo2a
    293        field(:) = -99999.
    294        CALL prism_get_proto(in_var_id(i), ktime, field(istart:iend), ierror)
    295        tab_get(:,:,i) = RESHAPE(field(:),(/iim,jj_nb/))
     338    DO i = 1, maxrecv
     339      IF (inforecv(i)%action) THEN
     340          field(:) = -99999.
     341          CALL prism_get_proto(inforecv(i)%nid, ktime, field(istart:iend), ierror)
     342          tab_get(:,:,i) = RESHAPE(field(:),(/iim,jj_nb/))
    296343       
    297        IF (ierror .NE. PRISM_Ok .AND. ierror.NE.PRISM_Recvd .AND. &
    298             ierror.NE.PRISM_FromRest &
    299             .AND. ierror.NE.PRISM_Input .AND. ierror.NE.PRISM_RecvOut &
    300             .AND. ierror.NE.PRISM_FromRestOut) THEN
    301           WRITE (nuout,*)  cl_read(i), ktime   
    302           abort_message=' Probleme dans prism_get_proto '
    303           CALL abort_gcm(modname,abort_message,1)
    304        ENDIF
     344          IF (ierror .NE. PRISM_Ok .AND. ierror.NE.PRISM_Recvd .AND. &
     345             ierror.NE.PRISM_FromRest &
     346             .AND. ierror.NE.PRISM_Input .AND. ierror.NE.PRISM_RecvOut &
     347             .AND. ierror.NE.PRISM_FromRestOut) THEN
     348              WRITE (lunout,*)  'Error with receiving filed : ', inforecv(i)%name, ktime   
     349              abort_message=' Problem in prism_get_proto '
     350              CALL abort_gcm(modname,abort_message,1)
     351          ENDIF
     352      ENDIF
    305353    END DO
    306354   
    … …  
    321369!
    322370    INCLUDE "dimensions.h"
     371    INCLUDE "iniprint.h"
    323372! Input arguments
    324373!************************************************************************************
    325     INTEGER, INTENT(IN)                                          :: ktime
    326     LOGICAL, INTENT(IN)                                          :: last
    327     REAL, DIMENSION(iim, jj_nb, jpflda2o1+jpflda2o2), INTENT(IN) :: tab_put
     374    INTEGER, INTENT(IN)                              :: ktime
     375    LOGICAL, INTENT(IN)                              :: last
     376    REAL, DIMENSION(iim, jj_nb, maxsend), INTENT(IN) :: tab_put
    328377
    329378! Local variables
    … …  
    332381    INTEGER                          :: istart,iend
    333382    INTEGER                          :: wstart,wend
    334     INTEGER, PARAMETER               :: nuout = 6
    335383    INTEGER                          :: ierror, i
    336384    REAL, DIMENSION(iim*jj_nb)       :: field
    … …  
    341389    checkout=.FALSE.
    342390
    343     WRITE(nuout,*) ' '
    344     WRITE(nuout,*) 'Intocpl: sending fields to CPL, ktime= ', ktime
    345     WRITE(nuout,*) 'last ', last
    346     WRITE(nuout,*)
     391    WRITE(lunout,*) ' '
     392    WRITE(lunout,*) 'Intocpl: sending fields to CPL, ktime= ', ktime
     393    WRITE(lunout,*) 'last = ', last
     394    WRITE(lunout,*)
    347395
    348396
    … …  
    360408       IF (is_south_pole) wend=iend-iim+1
    361409       
    362        field = RESHAPE(tab_put(:,:,8),(/iim*jj_nb/))
    363        CALL writeField_phy("fsolice",field(wstart:wend),1)
    364        field = RESHAPE(tab_put(:,:,9),(/iim*jj_nb/))
    365        CALL writeField_phy("fsolwat",field(wstart:wend),1)
    366        field = RESHAPE(tab_put(:,:,10),(/iim*jj_nb/))
    367        CALL writeField_phy("fnsolice",field(wstart:wend),1)
    368        field = RESHAPE(tab_put(:,:,11),(/iim*jj_nb/))
    369        CALL writeField_phy("fnsolwat",field(wstart:wend),1)
    370        field = RESHAPE(tab_put(:,:,12),(/iim*jj_nb/))
    371        CALL writeField_phy("fnsicedt",field(wstart:wend),1)
    372        field = RESHAPE(tab_put(:,:,13),(/iim*jj_nb/))
    373        CALL writeField_phy("evice",field(wstart:wend),1)
    374        field = RESHAPE(tab_put(:,:,14),(/iim*jj_nb/))
    375        CALL writeField_phy("evwat",field(wstart:wend),1)
    376        field = RESHAPE(tab_put(:,:,15),(/iim*jj_nb/))
    377        CALL writeField_phy("lpre",field(wstart:wend),1)
    378        field = RESHAPE(tab_put(:,:,16),(/iim*jj_nb/))
    379        CALL writeField_phy("spre",field(wstart:wend),1)
    380        field = RESHAPE(tab_put(:,:,17),(/iim*jj_nb/))
    381        CALL writeField_phy("dirunoff",field(wstart:wend),1)
    382        field = RESHAPE(tab_put(:,:,18),(/iim*jj_nb/))
    383        CALL writeField_phy("rivrunoff",field(wstart:wend),1)
    384        field = RESHAPE(tab_put(:,:,19),(/iim*jj_nb/))
    385        CALL writeField_phy("calving",field(wstart:wend),1)
    386        field = RESHAPE(tab_put(:,:,1),(/iim*jj_nb/))
    387        CALL writeField_phy("tauxx_u",field(wstart:wend),1)
    388        field = RESHAPE(tab_put(:,:,2),(/iim*jj_nb/))
    389        CALL writeField_phy("tauyy_u",field(wstart:wend),1)
    390        field = RESHAPE(tab_put(:,:,3),(/iim*jj_nb/))
    391        CALL writeField_phy("tauzz_u",field(wstart:wend),1)
    392        field = RESHAPE(tab_put(:,:,4),(/iim*jj_nb/))
    393        CALL writeField_phy("tauxx_v",field(wstart:wend),1)
    394        field = RESHAPE(tab_put(:,:,5),(/iim*jj_nb/))
    395        CALL writeField_phy("tauyy_v",field(wstart:wend),1)
    396        field = RESHAPE(tab_put(:,:,6),(/iim*jj_nb/))
    397        CALL writeField_phy("tauzz_v",field(wstart:wend),1)
    398        field = RESHAPE(tab_put(:,:,7),(/iim*jj_nb/))
    399        CALL writeField_phy("windsp",field(wstart:wend),1)
    400     ENDIF
    401    
     410       DO i = 1, maxsend
     411          IF (infosend(i)%action) THEN
     412             field = RESHAPE(tab_put(:,:,i),(/iim*jj_nb/))
     413             CALL writefield_phy(infosend(i)%name,field(wstart:wend),1)
     414          END IF
     415       END DO
     416    END IF
     417
    402418!************************************************************************************
    403419! PRISM_PUT
    404420!************************************************************************************
    405421
    406     DO i = 1, jpflda2o1+jpflda2o2
    407        field = RESHAPE(tab_put(:,:,i),(/iim*jj_nb/))
    408        CALL prism_put_proto(out_var_id(i), ktime, field(istart:iend), ierror)
    409        
    410        IF (ierror .NE. PRISM_Ok .AND. ierror.NE.PRISM_Sent .AND. ierror.NE.PRISM_ToRest &
    411             .AND. ierror.NE.PRISM_LocTrans .AND. ierror.NE.PRISM_Output .AND. &
    412             ierror.NE.PRISM_SentOut .AND. ierror.NE.PRISM_ToRestOut) THEN
    413           WRITE (nuout,*)  cl_writ(i), ktime   
    414           abort_message=' Probleme dans prism_put_proto '
    415           CALL abort_gcm(modname,abort_message,1)
    416        ENDIF
    417        
     422    DO i = 1, maxsend
     423      IF (infosend(i)%action) THEN
     424          field = RESHAPE(tab_put(:,:,i),(/iim*jj_nb/))
     425          CALL prism_put_proto(infosend(i)%nid, ktime, field(istart:iend), ierror)
     426         
     427          IF (ierror .NE. PRISM_Ok .AND. ierror.NE.PRISM_Sent .AND. ierror.NE.PRISM_ToRest &
     428             .AND. ierror.NE.PRISM_LocTrans .AND. ierror.NE.PRISM_Output .AND. &
     429             ierror.NE.PRISM_SentOut .AND. ierror.NE.PRISM_ToRestOut) THEN
     430              WRITE (lunout,*) 'Error with sending field :', infosend(i)%name, ktime   
     431              abort_message=' Problem in prism_put_proto '
     432              CALL abort_gcm(modname,abort_message,1)
     433          ENDIF
     434      ENDIF
    418435    END DO
    419436   
    … …  
    427444          CALL prism_terminate_proto(ierror)
    428445          IF (ierror .NE. PRISM_Ok) THEN
    429              abort_message=' Probleme dans prism_terminate_proto '
     446             abort_message=' Problem in prism_terminate_proto '
    430447             CALL abort_gcm(modname,abort_message,1)
    431448          ENDIF
Note: See TracChangeset for help on using the changeset viewer.