New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 12580 for NEMO/branches – NEMO

Changeset 12580 for NEMO/branches


Ignore:
Timestamp:
2020-03-20T19:38:24+01:00 (4 years ago)
Author:
dancopsey
Message:

Add 1D river coupling code from changeset 10269 of GO6 package branch
branches/UKMO/dev_r5518_GO6_package

Location:
NEMO/branches/UKMO/NEMO_4.0.1_icesheet_and_river_coupling/src/OCE/SBC
Files:
1 added
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/UKMO/NEMO_4.0.1_icesheet_and_river_coupling/src/OCE/SBC/cpl_oasis3.F90

    r11715 r12580  
    2929#endif 
    3030   USE par_oce                      ! ocean parameters 
     31   USE cpl_rnf_1d, ONLY: nn_cpl_river   ! Variables used in 1D river outflow  
    3132   USE dom_oce                      ! ocean space and time domain 
    3233   USE in_out_manager               ! I/O manager 
     
    3536   IMPLICIT NONE 
    3637   PRIVATE 
     38 
     39#if ! defined key_oasis3  
     40   ! Dummy interface to oasis_get if not using oasis  
     41   INTERFACE oasis_get  
     42      MODULE PROCEDURE oasis_get_1d, oasis_get_2d  
     43   END INTERFACE  
     44#endif  
    3745 
    3846   PUBLIC   cpl_init 
     
    4048   PUBLIC   cpl_snd 
    4149   PUBLIC   cpl_rcv 
     50   PUBLIC   cpl_rcv_1d 
    4251   PUBLIC   cpl_freq 
    4352   PUBLIC   cpl_finalize 
     
    8190      INTEGER               ::   nct       ! Number of categories in field 
    8291      INTEGER               ::   ncplmodel ! Maximum number of models to/from which this variable may be sent/received 
     92      INTEGER               ::   dimensions ! Number of dimensions of coupling field  
    8393   END TYPE FLD_CPL 
    8494 
     
    141151      ! 
    142152      INTEGER :: id_part 
     153      INTEGER :: id_part_0d     ! Partition for 0d fields  
     154      INTEGER :: id_part_rnf_1d ! Partition for 1d river outflow fields  
     155      INTEGER :: id_part_temp   ! Temperary partition used to choose either 0d or 1d partitions  
    143156      INTEGER :: paral(5)       ! OASIS3 box partition 
    144       INTEGER :: ishape(4)    ! shape of arrays passed to PSMILe 
     157      INTEGER :: ishape(4)      ! shape of 2D arrays passed to PSMILe 
     158      INTEGER :: ishape0d1d(2)  ! Shape of 0D or 1D arrays passed to PSMILe. 
     159      INTEGER :: var_nodims(2)  ! Number of coupling field dimensions. 
     160                                ! var_nodims(1) is redundant from OASIS3-MCT vn4.0 onwards 
     161                                ! but retained for backward compatibility.  
     162                                ! var_nodims(2) is the number of fields in a bundle  
     163                                ! or 1 for unbundled fields (bundles are not yet catered for 
     164                                ! in NEMO hence we default to 1).   
    145165      INTEGER :: ji,jc,jm       ! local loop indicees 
    146166      CHARACTER(LEN=64) :: zclname 
     
    185205      ishape(3) = 1 
    186206      ishape(4) = nlej-nldj+1 
     207 
     208      ishape0d1d(1) = 0  
     209      ishape0d1d(2) = 0  
    187210      ! 
    188211      ! ... Allocate memory for data exchange 
     
    211234    
    212235      CALL oasis_def_partition ( id_part, paral, nerror, jpiglo*jpjglo ) 
     236 
     237      ! A special partition is needed for 0D fields 
     238      
     239      paral(1) = 0                                       ! serial partitioning 
     240      paral(2) = 0    
     241      IF ( nproc == 0) THEN 
     242         paral(3) = 1                   ! Size of array to couple (scalar) 
     243      ELSE 
     244         paral(3) = 0                   ! Dummy size for PE's not involved 
     245      END IF 
     246      paral(4) = 0 
     247      paral(5) = 0 
     248         
     249      CALL oasis_def_partition ( id_part_0d, paral, nerror, 1 ) 
     250 
     251      ! Another partition is needed for 1D river routing fields 
     252       
     253      paral(1) = 0                                       ! serial partitioning 
     254      paral(2) = 0    
     255      IF ( nproc == 0) THEN 
     256         paral(3) = nn_cpl_river                   ! Size of array to couple (vector) 
     257      ELSE 
     258         paral(3) = 0                   ! Dummy size for PE's not involved 
     259      END IF 
     260      paral(4) = 0 
     261      paral(5) = 0 
     262 
     263 
     264      CALL oasis_def_partition ( id_part_rnf_1d, paral, nerror, nn_cpl_river ) 
     265 
    213266      ! 
    214267      ! ... Announce send variables.  
     
    289342#endif 
    290343                  IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In 
    291                   CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part   , (/ 2, 1 /),   & 
    292                      &                OASIS_In           , ishape , OASIS_REAL, nerror ) 
     344                  flush(numout) 
     345 
     346                  ! Define 0D (Greenland or Antarctic ice mass) or 1D (river outflow) coupling fields 
     347                  IF (srcv(ji)%dimensions <= 1) THEN 
     348                    var_nodims(1) = 1 
     349                    var_nodims(2) = 1 ! Modify this value to cater for bundled fields. 
     350                    IF (nproc == 0) THEN 
     351 
     352                       IF (srcv(ji)%dimensions == 0) THEN 
     353 
     354                          ! If 0D then set temporary variables to 0D components 
     355                          id_part_temp = id_part_0d 
     356                          ishape0d1d(2) = 1 
     357                       ELSE 
     358 
     359                          ! If 1D then set temporary variables to river outflow components 
     360                          id_part_temp = id_part_rnf_1d 
     361                          ishape0d1d(2)= nn_cpl_river 
     362 
     363                       END IF 
     364 
     365                       CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part_temp   , var_nodims,   & 
     366                                   OASIS_In           , ishape0d1d(1:2) , OASIS_REAL, nerror ) 
     367                    ELSE 
     368                       ! Dummy call to keep OASIS3-MCT happy. 
     369                       CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part_0d   , var_nodims,   & 
     370                                   OASIS_In           , ishape0d1d(1:2) , OASIS_REAL, nerror ) 
     371                    END IF 
     372                  ELSE 
     373                    ! It's a "normal" 2D (or pseudo 3D) coupling field.  
     374                    ! ... Set the field dimension and bundle count 
     375                    var_nodims(1) = 2 
     376                    var_nodims(2) = 1 ! Modify this value to cater for bundled fields. 
     377 
     378                    CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part   , var_nodims,   & 
     379                       &                OASIS_In           , ishape , OASIS_REAL, nerror ) 
     380                  ENDIF 
    293381                  IF ( nerror /= OASIS_Ok ) THEN 
    294382                     WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) 
     
    465553 
    466554 
     555   SUBROUTINE cpl_rcv_1d( kid, kstep, pdata, nitems, kinfo ) 
     556      !!--------------------------------------------------------------------- 
     557      !!              ***  ROUTINE cpl_rcv_1d  *** 
     558      !! 
     559      !! ** Purpose : - A special version of cpl_rcv to deal exclusively with 
     560      !! receipt of 0D or 1D fields.  
     561      !! The fields are recieved into a 1D array buffer which is simply a  
     562      !! dynamically sized sized array (which may be of size 1) 
     563      !! of 0 dimensional fields. This allows us to pass miltiple 0D  
     564      !! fields via a single put/get operation.   
     565      !!---------------------------------------------------------------------- 
     566      INTEGER , INTENT(in   ) ::   nitems      ! Number of 0D items to recieve  
     567                                               ! during this get operation. i.e. 
     568                                               ! The size of the 1D array in which 
     569                                               ! 0D items are passed.    
     570      INTEGER , INTENT(in   ) ::   kid         ! ID index of the incoming 
     571                                               ! data.   
     572      INTEGER , INTENT(in   ) ::   kstep       ! ocean time-step in seconds 
     573      REAL(wp), INTENT(inout) ::   pdata(1:nitems) ! The original value(s),   
     574                                                   ! unchanged if nothing is  
     575                                                   ! received 
     576      INTEGER , INTENT(  out) ::   kinfo       ! OASIS3 info argument 
     577      !!  
     578      REAL(wp) ::   recvfld(1:nitems)          ! Local receive field buffer 
     579      INTEGER  ::   jc,jm     ! local loop index 
     580      INTEGER  ::   ierr 
     581      LOGICAL  ::   llaction 
     582      INTEGER  ::   MPI_WORKING_PRECISION 
     583      INTEGER  ::   number_to_print  
     584      !!-------------------------------------------------------------------- 
     585      ! 
     586      ! receive local data from OASIS3 on every process 
     587      ! 
     588      kinfo = OASIS_idle 
     589      ! 
     590      ! 0D and 1D fields won't have categories or any other form of "pseudo level"  
     591      ! so we only cater for a single set of values and thus don't bother  
     592      ! with a loop over the jc index  
     593      jc = 1 
     594 
     595      DO jm = 1, srcv(kid)%ncplmodel 
     596 
     597         IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 
     598 
     599            IF ( ( srcv(kid)%dimensions <= 1) .AND. (nproc == 0) ) THEN 
     600               ! Since there is no concept of data decomposition for zero  
     601               ! dimension fields, they must only be exchanged through the master PE,  
     602               ! unlike "normal" 2D field cases where every PE is involved.  
     603 
     604               CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, recvfld, kinfo )    
     605                
     606               llaction =  kinfo == OASIS_Recvd   .OR. kinfo == OASIS_FromRest .OR.   & 
     607                           kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 
     608                
     609               IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , & 
     610                                     llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 
     611                
     612               IF ( llaction ) THEN 
     613                   
     614                  kinfo = OASIS_Rcv 
     615                  pdata(1:nitems) = recvfld(1:nitems)  
     616                   
     617                  IF ( ln_ctl ) THEN         
     618                     number_to_print = 10 
     619                     IF ( nitems < number_to_print ) number_to_print = nitems 
     620                     WRITE(numout,*) '****************' 
     621                     WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname 
     622                     WRITE(numout,*) 'oasis_get: ivarid '  , srcv(kid)%nid(jc,jm) 
     623                     WRITE(numout,*) 'oasis_get:   kstep', kstep 
     624                     WRITE(numout,*) 'oasis_get:   info ', kinfo 
     625                     WRITE(numout,*) '     - Minimum Value is ', MINVAL(pdata(:)) 
     626                     WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(:)) 
     627                     WRITE(numout,*) '     - Start of data is ', pdata(1:number_to_print) 
     628                     WRITE(numout,*) '****************' 
     629                     IF(lflush) CALL flush(numout) 
     630                  ENDIF 
     631                   
     632               ENDIF 
     633            ENDIF    
     634          ENDIF 
     635             
     636       ENDDO 
     637        
     638       ! Set the precision that we want to broadcast using MPI_BCAST 
     639       SELECT CASE( wp ) 
     640       CASE( sp )  
     641         MPI_WORKING_PRECISION = MPI_REAL                ! Single precision 
     642       CASE( dp ) 
     643         MPI_WORKING_PRECISION = MPI_DOUBLE_PRECISION    ! Double precision 
     644       CASE default 
     645         CALL oasis_abort( ncomp_id, "cpl_rcv_1d", "Could not find precision for coupling 0d or 1d field" ) 
     646       END SELECT 
     647 
     648       ! We have to broadcast (potentially) received values from PE 0 to all  
     649       ! the others. If no new data has been received we're just  
     650       ! broadcasting the existing values but there's no more efficient way  
     651       ! to deal with that w/o NEMO adopting a UM-style test mechanism 
     652       ! to determine active put/get timesteps.  
     653       CALL mpi_bcast( pdata, nitems, MPI_WORKING_PRECISION, localRoot, mpi_comm_opa, ierr ) 
     654 
     655      ! 
     656   END SUBROUTINE cpl_rcv_1d 
     657 
     658 
    467659   INTEGER FUNCTION cpl_freq( cdfieldname )   
    468660      !!--------------------------------------------------------------------- 
     
    572764   SUBROUTINE oasis_def_var(k1,cd1,k2,k3,k4,k5,k6,k7) 
    573765      CHARACTER(*), INTENT(in   ) ::  cd1 
    574       INTEGER     , INTENT(in   ) ::  k2,k3(2),k4,k5(2,2),k6 
     766      INTEGER     , INTENT(in   ) ::  k2,k3(2),k4,k5(*),k6 
    575767      INTEGER     , INTENT(  out) ::  k1,k7 
    576768      k1 = -1 ; k7 = -1 
     
    592784   END SUBROUTINE oasis_put 
    593785 
    594    SUBROUTINE oasis_get(k1,k2,p1,k3) 
     786   SUBROUTINE oasis_get_1d(k1,k2,p1,k3) 
     787      REAL(wp), DIMENSION(:)  , INTENT(  out) ::  p1 
     788      INTEGER                 , INTENT(in   ) ::  k1,k2 
     789      INTEGER                 , INTENT(  out) ::  k3 
     790      p1(1) = -1. ; k3 = -1 
     791      WRITE(numout,*) 'oasis_get_1d: Error you sould not be there...' 
     792   END SUBROUTINE oasis_get_1d 
     793 
     794   SUBROUTINE oasis_get_2d(k1,k2,p1,k3) 
    595795      REAL(wp), DIMENSION(:,:), INTENT(  out) ::  p1 
    596796      INTEGER                 , INTENT(in   ) ::  k1,k2 
    597797      INTEGER                 , INTENT(  out) ::  k3 
    598798      p1(1,1) = -1. ; k3 = -1 
    599       WRITE(numout,*) 'oasis_get: Error you sould not be there...' 
    600    END SUBROUTINE oasis_get 
     799      WRITE(numout,*) 'oasis_get_2d: Error you sould not be there...' 
     800   END SUBROUTINE oasis_get_2d 
    601801 
    602802   SUBROUTINE oasis_get_freqs(k1,k5,k2,k3,k4) 
  • NEMO/branches/UKMO/NEMO_4.0.1_icesheet_and_river_coupling/src/OCE/SBC/sbccpl.F90

    r12577 r12580  
    3636   USE eosbn2         !  
    3737   USE sbcrnf  , ONLY : l_rnfcpl 
     38   USE cpl_rnf_1d, ONLY: nn_cpl_river, cpl_rnf_1d_init, cpl_rnf_1d_to_2d   ! Variables used in 1D river outflow  
    3839   USE sbcisf  , ONLY : l_isfcpl 
    3940#if defined key_cice 
     
    118119   INTEGER, PARAMETER ::   jpr_grnm   = 58   ! Greenland ice mass  
    119120   INTEGER, PARAMETER ::   jpr_antm   = 59   ! Antarctic ice mass  
    120  
    121    INTEGER, PARAMETER ::   jprcv      = 59   ! total number of fields received   
     121   INTEGER, PARAMETER ::   jpr_rnf_1d = 60            ! 1D river runoff  
     122 
     123   INTEGER, PARAMETER ::   jprcv      = 60   ! total number of fields received   
    122124 
    123125   INTEGER, PARAMETER ::   jps_fice   =  1   ! ice fraction sent to the atmosphere 
     
    361363 
    362364      ! default definitions of srcv 
    363       srcv(:)%laction = .FALSE.   ;   srcv(:)%clgrid = 'T'   ;   srcv(:)%nsgn = 1.   ;   srcv(:)%nct = 1 
     365      srcv(:)%laction = .FALSE.  
     366      srcv(:)%clgrid = 'T'  
     367      srcv(:)%nsgn = 1.  
     368      srcv(:)%nct = 1  
     369      srcv(:)%dimensions = 2  
    364370 
    365371      !                                                      ! ------------------------- ! 
     
    478484      !                                                      ! ------------------------- ! 
    479485      srcv(jpr_rnf   )%clname = 'O_Runoff' 
    480       IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN 
    481          srcv(jpr_rnf)%laction = .TRUE. 
     486      srcv(jpr_rnf_1d   )%clname = 'ORunff1D'  
     487      IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' .OR. TRIM( sn_rcv_rnf%cldes ) == 'coupled1d' ) THEN   
     488         IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) srcv(jpr_rnf)%laction = .TRUE.  
     489         IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled1d' ) THEN  
     490            srcv(jpr_rnf_1d)%laction = .TRUE.  
     491            srcv(jpr_rnf_1d)%dimensions = 1 ! 1D field passed through coupler  
     492         END IF  
    482493         l_rnfcpl              = .TRUE.                      ! -> no need to read runoffs in sbcrnf 
    483494         ln_rnf                = nn_components /= jp_iam_sas ! -> force to go through sbcrnf if not sas 
     
    486497      ENDIF 
    487498      ! 
    488       srcv(jpr_cal)%clname = 'OCalving'   ;  IF( TRIM( sn_rcv_cal%cldes) == 'coupled' )   srcv(jpr_cal)%laction = .TRUE. 
    489       srcv(jpr_grnm  )%clname = 'OGrnmass'   ;   IF( TRIM( sn_rcv_grnm%cldes ) == 'coupled' )   srcv(jpr_grnm)%laction = .TRUE.  
    490       srcv(jpr_antm  )%clname = 'OAntmass'   ;   IF( TRIM( sn_rcv_antm%cldes ) == 'coupled' )   srcv(jpr_antm)%laction = .TRUE.  
     499      srcv(jpr_cal   )%clname = 'OCalving'     
     500      IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' )   srcv(jpr_cal)%laction = .TRUE.       
     501  
     502      srcv(jpr_grnm  )%clname = 'OGrnmass'   
     503      IF( TRIM( sn_rcv_grnm%cldes ) == 'coupled' .OR. TRIM( sn_rcv_grnm%cldes ) == 'coupled0d' ) srcv(jpr_grnm)%laction = .TRUE.          
     504      IF( TRIM( sn_rcv_grnm%cldes ) == 'coupled0d' ) srcv(jpr_grnm  )%dimensions = 0 ! Scalar field  
     505        
     506      srcv(jpr_antm  )%clname = 'OAntmass'  
     507      IF( TRIM( sn_rcv_antm%cldes ) == 'coupled' .OR. TRIM( sn_rcv_antm%cldes ) == 'coupled0d' )  srcv(jpr_antm)%laction = .TRUE.  
     508      IF( TRIM( sn_rcv_antm%cldes ) == 'coupled0d' ) srcv(jpr_antm  )%dimensions = 0 ! Scalar field    
    491509      srcv(jpr_isf)%clname = 'OIcshelf'   ;  IF( TRIM( sn_rcv_isf%cldes) == 'coupled' )   srcv(jpr_isf)%laction = .TRUE. 
    492510      srcv(jpr_icb)%clname = 'OIceberg'   ;  IF( TRIM( sn_rcv_icb%cldes) == 'coupled' )   srcv(jpr_icb)%laction = .TRUE. 
     
    733751         ENDIF 
    734752      ENDIF 
    735        
    736       ! =================================================== ! 
    737       ! Allocate all parts of frcv used for received fields ! 
    738       ! =================================================== ! 
    739       DO jn = 1, jprcv 
    740          IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 
    741       END DO 
    742       ! Allocate taum part of frcv which is used even when not received as coupling field 
    743       IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 
    744       ! Allocate w10m part of frcv which is used even when not received as coupling field 
    745       IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) ) 
    746       ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field 
    747       IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) ) 
    748       IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) ) 
    749       ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 
    750       IF( k_ice /= 0 ) THEN 
    751          IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) ) 
    752          IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) ) 
    753       END IF 
    754753 
    755754      ! ================================ ! 
     
    761760       
    762761      ! default definitions of nsnd 
    763       ssnd(:)%laction = .FALSE.   ;   ssnd(:)%clgrid = 'T'   ;   ssnd(:)%nsgn = 1.  ; ssnd(:)%nct = 1 
     762      ssnd(:)%laction = .FALSE.  
     763      ssnd(:)%clgrid = 'T'  
     764      ssnd(:)%nsgn = 1.  
     765      ssnd(:)%nct = 1  
     766      ssnd(:)%dimensions = 2  
    764767          
    765768      !                                                      ! ------------------------- ! 
     
    10401043         ENDIF 
    10411044      ENDIF 
     1045 
     1046      ! Initialise 1D river outflow scheme  
     1047      nn_cpl_river = 1  
     1048      IF ( TRIM( sn_rcv_rnf%cldes ) == 'coupled1d' ) CALL cpl_rnf_1d_init   ! Coupled runoff using 1D array 
     1049       
     1050      ! =================================================== ! 
     1051      ! Allocate all parts of frcv used for received fields ! 
     1052      ! =================================================== ! 
     1053      DO jn = 1, jprcv 
     1054 
     1055         IF ( srcv(jn)%laction ) THEN  
     1056            SELECT CASE( srcv(jn)%dimensions ) 
     1057            ! 
     1058            CASE( 0 )   ! Scalar field 
     1059               ALLOCATE( frcv(jn)%z3(1,1,1) ) 
     1060                
     1061            CASE( 1 )   ! 1D field 
     1062               ALLOCATE( frcv(jn)%z3(nn_cpl_river,1,1) ) 
     1063                
     1064            CASE DEFAULT  ! 2D (or pseudo 3D) field. 
     1065               ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 
     1066                
     1067            END SELECT 
     1068         END IF 
     1069 
     1070      END DO 
     1071      ! Allocate taum part of frcv which is used even when not received as coupling field 
     1072      IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 
     1073      ! Allocate w10m part of frcv which is used even when not received as coupling field 
     1074      IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) ) 
     1075      ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field 
     1076      IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) ) 
     1077      IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) ) 
     1078      ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 
     1079      IF( k_ice /= 0 ) THEN 
     1080         IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) ) 
     1081         IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) ) 
     1082      END IF 
    10421083 
    10431084      ! 
     
    11621203      isec = ( kt - nit000 ) * NINT( rdt )                      ! date of exchanges 
    11631204      DO jn = 1, jprcv                                          ! received fields sent by the atmosphere 
    1164          IF( srcv(jn)%laction )   CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) ) 
     1205        IF( srcv(jn)%laction ) THEN   
     1206  
     1207          IF ( srcv(jn)%dimensions <= 1 ) THEN  
     1208            CALL cpl_rcv_1d( jn, isec, frcv(jn)%z3, SIZE(frcv(jn)%z3), nrcvinfo(jn) )  
     1209          ELSE  
     1210            CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) )  
     1211          END IF  
     1212 
     1213        END IF  
    11651214      END DO 
    11661215 
     
    18181867       
    18191868      ! --- Continental fluxes --- ! 
    1820       IF( srcv(jpr_rnf)%laction ) THEN   ! runoffs (included in emp later on) 
     1869      IF( srcv(jpr_rnf)%laction ) THEN   ! 2D runoffs (included in emp later on) 
    18211870         rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 
     1871      ENDIF 
     1872      IF( srcv(jpr_rnf_1d)%laction ) THEN ! 1D runoff 
     1873         CALL cpl_rnf_1d_to_2d(frcv(jpr_rnf_1d)%z3(:,:,:)) 
    18221874      ENDIF 
    18231875      IF( srcv(jpr_cal)%laction ) THEN   ! calving (put in emp_tot and emp_oce) 
     
    18581910      zsnw(:,:) = picefr(:,:) 
    18591911      ! --- Continental fluxes --- ! 
    1860       IF( srcv(jpr_rnf)%laction ) THEN   ! runoffs (included in emp later on) 
     1912      IF( srcv(jpr_rnf)%laction ) THEN   ! 2D runoffs (included in emp later on) 
    18611913         rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 
     1914      ENDIF 
     1915      IF( srcv(jpr_rnf_1d)%laction ) THEN  ! 1D runoff 
     1916         CALL cpl_rnf_1d_to_2d(frcv(jpr_rnf_1d)%z3(:,:,:))  
    18621917      ENDIF 
    18631918      IF( srcv(jpr_cal)%laction ) THEN   ! calving (put in emp_tot) 
Note: See TracChangeset for help on using the changeset viewer.