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 5075 for branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90 – NEMO

Ignore:
Timestamp:
2015-02-11T11:50:34+01:00 (9 years ago)
Author:
timgraham
Message:

Upgraded branch to current head of trunk (r5072) so it can be used with the trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90

    r3294 r5075  
    22   !!====================================================================== 
    33   !!                    ***  MODULE cpl_oasis  *** 
    4    !! Coupled O/A : coupled ocean-atmosphere case using OASIS3 V. prism_2_4 
    5    !!               special case: NEMO OPA/LIM coupled to ECHAM5 
     4   !! Coupled O/A : coupled ocean-atmosphere case using OASIS3-MCT 
    65   !!===================================================================== 
    76   !! History :    
     
    1514   !!   3.4  !  11-11  (C. Harris) Changes to allow mutiple category fields 
    1615   !!---------------------------------------------------------------------- 
     16   !!---------------------------------------------------------------------- 
     17   !!   'key_oasis3'                    coupled Ocean/Atmosphere via OASIS3 
     18   !!---------------------------------------------------------------------- 
     19   !!   cpl_init     : initialization of coupled mode communication 
     20   !!   cpl_define   : definition of grid and fields 
     21   !!   cpl_snd     : snd out fields in coupled mode 
     22   !!   cpl_rcv     : receive fields in coupled mode 
     23   !!   cpl_finalize : finalize the coupled mode communication 
     24   !!---------------------------------------------------------------------- 
    1725#if defined key_oasis3 
    18    !!---------------------------------------------------------------------- 
    19    !!   'key_oasis3'                    coupled Ocean/Atmosphere via OASIS3 
    20    !!---------------------------------------------------------------------- 
    21    !!   cpl_prism_init     : initialization of coupled mode communication 
    22    !!   cpl_prism_define   : definition of grid and fields 
    23    !!   cpl_prism_snd     : snd out fields in coupled mode 
    24    !!   cpl_prism_rcv     : receive fields in coupled mode 
    25    !!   cpl_prism_finalize : finalize the coupled mode communication 
    26    !!---------------------------------------------------------------------- 
    27    USE mod_prism_proto              ! OASIS3 prism module 
    28    USE mod_prism_def_partition_proto! OASIS3 prism module for partitioning 
    29    USE mod_prism_put_proto          ! OASIS3 prism module for snding 
    30    USE mod_prism_get_proto          ! OASIS3 prism module for receiving 
    31    USE mod_comprism_proto           ! OASIS3 prism module to get coupling frequency 
     26   USE mod_oasis                    ! OASIS3-MCT module 
     27#endif 
    3228   USE par_oce                      ! ocean parameters 
    3329   USE dom_oce                      ! ocean space and time domain 
     
    3834   PRIVATE 
    3935 
    40    PUBLIC   cpl_prism_init 
    41    PUBLIC   cpl_prism_define 
    42    PUBLIC   cpl_prism_snd 
    43    PUBLIC   cpl_prism_rcv 
    44    PUBLIC   cpl_prism_freq 
    45    PUBLIC   cpl_prism_finalize 
    46  
    47    LOGICAL, PUBLIC, PARAMETER ::   lk_cpl = .TRUE.   !: coupled flag 
     36   PUBLIC   cpl_init 
     37   PUBLIC   cpl_define 
     38   PUBLIC   cpl_snd 
     39   PUBLIC   cpl_rcv 
     40   PUBLIC   cpl_freq 
     41   PUBLIC   cpl_finalize 
     42 
    4843   INTEGER, PUBLIC            ::   OASIS_Rcv  = 1    !: return code if received field 
    4944   INTEGER, PUBLIC            ::   OASIS_idle = 0    !: return code if nothing done by oasis 
    50    INTEGER                    ::   ncomp_id          ! id returned by prism_init_comp 
     45   INTEGER                    ::   ncomp_id          ! id returned by oasis_init_comp 
    5146   INTEGER                    ::   nerror            ! return error code 
    52  
    53    INTEGER, PARAMETER ::   nmaxfld=40    ! Maximum number of coupling fields 
     47#if ! defined key_oasis3 
     48   ! OASIS Variables not used. defined only for compilation purpose 
     49   INTEGER                    ::   OASIS_Out         = -1 
     50   INTEGER                    ::   OASIS_REAL        = -1 
     51   INTEGER                    ::   OASIS_Ok          = -1 
     52   INTEGER                    ::   OASIS_In          = -1 
     53   INTEGER                    ::   OASIS_Sent        = -1 
     54   INTEGER                    ::   OASIS_SentOut     = -1 
     55   INTEGER                    ::   OASIS_ToRest      = -1 
     56   INTEGER                    ::   OASIS_ToRestOut   = -1 
     57   INTEGER                    ::   OASIS_Recvd       = -1 
     58   INTEGER                    ::   OASIS_RecvOut     = -1 
     59   INTEGER                    ::   OASIS_FromRest    = -1 
     60   INTEGER                    ::   OASIS_FromRestOut = -1 
     61#endif 
     62 
     63   INTEGER, PUBLIC, PARAMETER ::   nmaxfld=40        ! Maximum number of coupling fields 
     64   INTEGER, PUBLIC, PARAMETER ::   nmaxcat=5    ! Maximum number of coupling fields 
     65   INTEGER, PUBLIC, PARAMETER ::   nmaxcpl=5    ! Maximum number of coupling fields 
    5466    
    5567   TYPE, PUBLIC ::   FLD_CPL               !: Type for coupling field information 
     
    5870      CHARACTER(len = 1)    ::   clgrid    ! Grid type   
    5971      REAL(wp)              ::   nsgn      ! Control of the sign change 
    60       INTEGER, DIMENSION(9) ::   nid       ! Id of the field (no more than 9 categories) 
     72      INTEGER, DIMENSION(nmaxcat,nmaxcpl) ::   nid   ! Id of the field (no more than 9 categories and 9 extrena models) 
    6173      INTEGER               ::   nct       ! Number of categories in field 
     74      INTEGER               ::   ncplmodel ! Maximum number of models to/from which this variable may be sent/received 
    6275   END TYPE FLD_CPL 
    6376 
     
    7386CONTAINS 
    7487 
    75    SUBROUTINE cpl_prism_init( kl_comm ) 
     88   SUBROUTINE cpl_init( kl_comm ) 
    7689      !!------------------------------------------------------------------- 
    77       !!             ***  ROUTINE cpl_prism_init  *** 
     90      !!             ***  ROUTINE cpl_init  *** 
    7891      !! 
    7992      !! ** Purpose :   Initialize coupled mode communication for ocean 
     
    89102 
    90103      !------------------------------------------------------------------ 
    91       ! 1st Initialize the PRISM system for the application 
     104      ! 1st Initialize the OASIS system for the application 
    92105      !------------------------------------------------------------------ 
    93       CALL prism_init_comp_proto ( ncomp_id, 'oceanx', nerror ) 
    94       IF ( nerror /= PRISM_Ok ) & 
    95          CALL prism_abort_proto (ncomp_id, 'cpl_prism_init', 'Failure in prism_init_comp_proto') 
     106      CALL oasis_init_comp ( ncomp_id, 'oceanx', nerror ) 
     107      IF ( nerror /= OASIS_Ok ) & 
     108         CALL oasis_abort (ncomp_id, 'cpl_init', 'Failure in oasis_init_comp') 
    96109 
    97110      !------------------------------------------------------------------ 
     
    99112      !------------------------------------------------------------------ 
    100113 
    101       CALL prism_get_localcomm_proto ( kl_comm, nerror ) 
    102       IF ( nerror /= PRISM_Ok ) & 
    103          CALL prism_abort_proto (ncomp_id, 'cpl_prism_init','Failure in prism_get_localcomm_proto' ) 
    104       ! 
    105    END SUBROUTINE cpl_prism_init 
    106  
    107  
    108    SUBROUTINE cpl_prism_define( krcv, ksnd ) 
     114      CALL oasis_get_localcomm ( kl_comm, nerror ) 
     115      IF ( nerror /= OASIS_Ok ) & 
     116         CALL oasis_abort (ncomp_id, 'cpl_init','Failure in oasis_get_localcomm' ) 
     117      ! 
     118   END SUBROUTINE cpl_init 
     119 
     120 
     121   SUBROUTINE cpl_define( krcv, ksnd, kcplmodel ) 
    109122      !!------------------------------------------------------------------- 
    110       !!             ***  ROUTINE cpl_prism_define  *** 
     123      !!             ***  ROUTINE cpl_define  *** 
    111124      !! 
    112125      !! ** Purpose :   Define grid and field information for ocean 
     
    116129      !!-------------------------------------------------------------------- 
    117130      INTEGER, INTENT(in) ::   krcv, ksnd     ! Number of received and sent coupling fields 
     131      INTEGER, INTENT(in) ::   kcplmodel      ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 
    118132      ! 
    119133      INTEGER :: id_part 
    120134      INTEGER :: paral(5)       ! OASIS3 box partition 
    121135      INTEGER :: ishape(2,2)    ! shape of arrays passed to PSMILe 
    122       INTEGER :: ji,jc          ! local loop indicees 
    123       CHARACTER(LEN=8) :: zclname 
     136      INTEGER :: ji,jc,jm       ! local loop indicees 
     137      CHARACTER(LEN=64) :: zclname 
     138      CHARACTER(LEN=2) :: cli2 
    124139      !!-------------------------------------------------------------------- 
    125140 
    126141      IF(lwp) WRITE(numout,*) 
    127       IF(lwp) WRITE(numout,*) 'cpl_prism_define : initialization in coupled ocean/atmosphere case' 
     142      IF(lwp) WRITE(numout,*) 'cpl_define : initialization in coupled ocean/atmosphere case' 
    128143      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~' 
    129144      IF(lwp) WRITE(numout,*) 
    130145 
     146      IF( kcplmodel > nmaxcpl ) THEN 
     147         CALL oasis_abort ( ncomp_id, 'cpl_define', 'kcplmodel is larger than nmaxcpl, increase nmaxcpl')   ;   RETURN 
     148      ENDIF 
    131149      ! 
    132150      ! ... Define the shape for the area that excludes the halo 
     
    141159      ALLOCATE(exfld(nlei-nldi+1, nlej-nldj+1), stat = nerror) 
    142160      IF( nerror > 0 ) THEN 
    143          CALL prism_abort_proto ( ncomp_id, 'cpl_prism_define', 'Failure in allocating exfld')   ;   RETURN 
     161         CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in allocating exfld')   ;   RETURN 
    144162      ENDIF 
    145163      ! 
     
    161179      ENDIF 
    162180       
    163       CALL prism_def_partition_proto ( id_part, paral, nerror ) 
     181      CALL oasis_def_partition ( id_part, paral, nerror ) 
    164182      ! 
    165183      ! ... Announce send variables.  
    166184      ! 
     185      ssnd(:)%ncplmodel = kcplmodel 
     186      ! 
    167187      DO ji = 1, ksnd 
    168          IF ( ssnd(ji)%laction ) THEN  
     188         IF ( ssnd(ji)%laction ) THEN 
     189 
     190            IF( ssnd(ji)%nct > nmaxcat ) THEN 
     191               CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '//   & 
     192                  &              TRIM(ssnd(ji)%clname)//' is larger than nmaxcat, increase nmaxcat' ) 
     193               RETURN 
     194            ENDIF 
     195             
    169196            DO jc = 1, ssnd(ji)%nct 
    170                IF ( ssnd(ji)%nct .gt. 1 ) THEN 
    171                   WRITE(zclname,'( a7, i1)') ssnd(ji)%clname,jc 
    172                ELSE 
    173                   zclname=ssnd(ji)%clname 
    174                ENDIF 
    175                WRITE(numout,*) "Define",ji,jc,zclname," for",PRISM_Out 
    176                CALL prism_def_var_proto (ssnd(ji)%nid(jc), zclname, id_part, (/ 2, 0/),   & 
    177                     PRISM_Out, ishape, PRISM_REAL, nerror) 
    178                IF ( nerror /= PRISM_Ok ) THEN 
    179                   WRITE(numout,*) 'Failed to define transient ', ji, TRIM(zclname) 
    180                   CALL prism_abort_proto ( ssnd(ji)%nid(jc), 'cpl_prism_define', 'Failure in prism_def_var') 
    181                ENDIF 
     197               DO jm = 1, kcplmodel 
     198 
     199                  IF ( ssnd(ji)%nct .GT. 1 ) THEN 
     200                     WRITE(cli2,'(i2.2)') jc 
     201                     zclname = TRIM(ssnd(ji)%clname)//'_cat'//cli2 
     202                  ELSE 
     203                     zclname = ssnd(ji)%clname 
     204                  ENDIF 
     205                  IF ( kcplmodel  > 1 ) THEN 
     206                     WRITE(cli2,'(i2.2)') jm 
     207                     zclname = 'model'//cli2//'_'//TRIM(zclname) 
     208                  ENDIF 
     209#if defined key_agrif 
     210                  IF( agrif_fixed() /= 0 ) THEN  
     211                     zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname) 
     212                  END IF 
     213#endif 
     214                  IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_Out 
     215                  CALL oasis_def_var (ssnd(ji)%nid(jc,jm), zclname, id_part   , (/ 2, 0 /),   & 
     216                     &                OASIS_Out          , ishape , OASIS_REAL, nerror ) 
     217                  IF ( nerror /= OASIS_Ok ) THEN 
     218                     WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) 
     219                     CALL oasis_abort ( ssnd(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' ) 
     220                  ENDIF 
     221                  IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple" 
     222                  IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple" 
     223               END DO 
    182224            END DO 
    183225         ENDIF 
     
    186228      ! ... Announce received variables.  
    187229      ! 
     230      srcv(:)%ncplmodel = kcplmodel 
     231      ! 
    188232      DO ji = 1, krcv 
    189233         IF ( srcv(ji)%laction ) THEN  
     234             
     235            IF( srcv(ji)%nct > nmaxcat ) THEN 
     236               CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '//   & 
     237                  &              TRIM(srcv(ji)%clname)//' is larger than nmaxcat, increase nmaxcat' ) 
     238               RETURN 
     239            ENDIF 
     240             
    190241            DO jc = 1, srcv(ji)%nct 
    191                IF ( srcv(ji)%nct .gt. 1 ) THEN 
    192                   WRITE(zclname,'( a7, i1)') srcv(ji)%clname,jc 
    193                ELSE 
    194                   zclname=srcv(ji)%clname 
    195                ENDIF 
    196                WRITE(numout,*) "Define",ji,jc,zclname," for",PRISM_In 
    197                CALL prism_def_var_proto ( srcv(ji)%nid(jc), zclname, id_part, (/ 2, 0/),   & 
    198                     &                      PRISM_In    , ishape   , PRISM_REAL, nerror) 
    199                IF ( nerror /= PRISM_Ok ) THEN 
    200                   WRITE(numout,*) 'Failed to define transient ', ji, TRIM(zclname) 
    201                   CALL prism_abort_proto ( srcv(ji)%nid(jc), 'cpl_prism_define', 'Failure in prism_def_var') 
    202                ENDIF 
     242               DO jm = 1, kcplmodel 
     243                   
     244                  IF ( srcv(ji)%nct .GT. 1 ) THEN 
     245                     WRITE(cli2,'(i2.2)') jc 
     246                     zclname = TRIM(srcv(ji)%clname)//'_cat'//cli2 
     247                  ELSE 
     248                     zclname = srcv(ji)%clname 
     249                  ENDIF 
     250                  IF ( kcplmodel  > 1 ) THEN 
     251                     WRITE(cli2,'(i2.2)') jm 
     252                     zclname = 'model'//cli2//'_'//TRIM(zclname) 
     253                  ENDIF 
     254#if defined key_agrif 
     255                  IF( agrif_fixed() /= 0 ) THEN  
     256                     zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname) 
     257                  END IF 
     258#endif 
     259                  IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In 
     260                  CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part   , (/ 2, 0 /),   & 
     261                     &                OASIS_In           , ishape , OASIS_REAL, nerror ) 
     262                  IF ( nerror /= OASIS_Ok ) THEN 
     263                     WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) 
     264                     CALL oasis_abort ( srcv(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' ) 
     265                  ENDIF 
     266                  IF( ln_ctl .AND. srcv(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple" 
     267                  IF( ln_ctl .AND. srcv(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple" 
     268 
     269               END DO 
    203270            END DO 
    204271         ENDIF 
     
    209276      !------------------------------------------------------------------ 
    210277       
    211       CALL prism_enddef_proto(nerror) 
    212       IF( nerror /= PRISM_Ok )   CALL prism_abort_proto ( ncomp_id, 'cpl_prism_define', 'Failure in prism_enddef') 
    213       ! 
    214    END SUBROUTINE cpl_prism_define 
     278      CALL oasis_enddef(nerror) 
     279      IF( nerror /= OASIS_Ok )   CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in oasis_enddef') 
     280      ! 
     281   END SUBROUTINE cpl_define 
    215282    
    216283    
    217    SUBROUTINE cpl_prism_snd( kid, kstep, pdata, kinfo ) 
     284   SUBROUTINE cpl_snd( kid, kstep, pdata, kinfo ) 
    218285      !!--------------------------------------------------------------------- 
    219       !!              ***  ROUTINE cpl_prism_snd  *** 
     286      !!              ***  ROUTINE cpl_snd  *** 
    220287      !! 
    221288      !! ** Purpose : - At each coupling time-step,this routine sends fields 
     
    227294      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pdata 
    228295      !! 
    229       INTEGER                                   ::   jc        ! local loop index 
     296      INTEGER                                   ::   jc,jm     ! local loop index 
    230297      !!-------------------------------------------------------------------- 
    231298      ! 
     
    233300      ! 
    234301      DO jc = 1, ssnd(kid)%nct 
    235  
    236          CALL prism_put_proto ( ssnd(kid)%nid(jc), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo ) 
    237           
    238          IF ( ln_ctl ) THEN         
    239             IF ( kinfo == PRISM_Sent     .OR. kinfo == PRISM_ToRest .OR.   & 
    240                  & kinfo == PRISM_SentOut  .OR. kinfo == PRISM_ToRestOut ) THEN 
    241                WRITE(numout,*) '****************' 
    242                WRITE(numout,*) 'prism_put_proto: Outgoing ', ssnd(kid)%clname 
    243                WRITE(numout,*) 'prism_put_proto: ivarid ', ssnd(kid)%nid(jc) 
    244                WRITE(numout,*) 'prism_put_proto:  kstep ', kstep 
    245                WRITE(numout,*) 'prism_put_proto:   info ', kinfo 
    246                WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(:,:,jc)) 
    247                WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(:,:,jc)) 
    248                WRITE(numout,*) '     -     Sum value is ', SUM(pdata(:,:,jc)) 
    249                WRITE(numout,*) '****************' 
     302         DO jm = 1, ssnd(kid)%ncplmodel 
     303         
     304            IF( ssnd(kid)%nid(jc,jm) /= -1 ) THEN 
     305               CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo ) 
     306                
     307               IF ( ln_ctl ) THEN         
     308                  IF ( kinfo == OASIS_Sent     .OR. kinfo == OASIS_ToRest .OR.   & 
     309                     & kinfo == OASIS_SentOut  .OR. kinfo == OASIS_ToRestOut ) THEN 
     310                     WRITE(numout,*) '****************' 
     311                     WRITE(numout,*) 'oasis_put: Outgoing ', ssnd(kid)%clname 
     312                     WRITE(numout,*) 'oasis_put: ivarid ', ssnd(kid)%nid(jc,jm) 
     313                     WRITE(numout,*) 'oasis_put:  kstep ', kstep 
     314                     WRITE(numout,*) 'oasis_put:   info ', kinfo 
     315                     WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(:,:,jc)) 
     316                     WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(:,:,jc)) 
     317                     WRITE(numout,*) '     -     Sum value is ', SUM(pdata(:,:,jc)) 
     318                     WRITE(numout,*) '****************' 
     319                  ENDIF 
     320               ENDIF 
     321                
    250322            ENDIF 
    251          ENDIF 
    252  
     323             
     324         ENDDO 
    253325      ENDDO 
    254326      ! 
    255     END SUBROUTINE cpl_prism_snd 
    256  
    257  
    258    SUBROUTINE cpl_prism_rcv( kid, kstep, pdata, kinfo ) 
     327    END SUBROUTINE cpl_snd 
     328 
     329 
     330   SUBROUTINE cpl_rcv( kid, kstep, pdata, pmask, kinfo ) 
    259331      !!--------------------------------------------------------------------- 
    260       !!              ***  ROUTINE cpl_prism_rcv  *** 
     332      !!              ***  ROUTINE cpl_rcv  *** 
    261333      !! 
    262334      !! ** Purpose : - At each coupling time-step,this routine receives fields 
     
    266338      INTEGER                   , INTENT(in   ) ::   kstep     ! ocean time-step in seconds 
    267339      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pdata     ! IN to keep the value if nothing is done 
     340      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pmask     ! coupling mask 
    268341      INTEGER                   , INTENT(  out) ::   kinfo     ! OASIS3 info argument 
    269342      !! 
    270       INTEGER                                   ::   jc        ! local loop index 
    271       LOGICAL                                   ::   llaction 
     343      INTEGER                                   ::   jc,jm     ! local loop index 
     344      LOGICAL                                   ::   llaction, llfisrt 
    272345      !!-------------------------------------------------------------------- 
    273346      ! 
    274347      ! receive local data from OASIS3 on every process 
    275348      ! 
     349      kinfo = OASIS_idle 
     350      ! 
    276351      DO jc = 1, srcv(kid)%nct 
    277  
    278          CALL prism_get_proto ( srcv(kid)%nid(jc), kstep, exfld, kinfo )          
    279           
    280          llaction = .false. 
    281          IF( kinfo == PRISM_Recvd   .OR. kinfo == PRISM_FromRest .OR.   & 
    282               kinfo == PRISM_RecvOut .OR. kinfo == PRISM_FromRestOut )   llaction = .TRUE. 
    283           
    284          IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc) 
    285           
    286          IF ( llaction ) THEN 
    287              
    288             kinfo = OASIS_Rcv 
    289             pdata(nldi:nlei, nldj:nlej,jc) = exfld(:,:) 
    290              
    291             !--- Fill the overlap areas and extra hallows (mpp) 
    292             !--- check periodicity conditions (all cases) 
    293             CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn )    
    294              
    295             IF ( ln_ctl ) THEN         
    296                WRITE(numout,*) '****************' 
    297                WRITE(numout,*) 'prism_get_proto: Incoming ', srcv(kid)%clname 
    298                WRITE(numout,*) 'prism_get_proto: ivarid '  , srcv(kid)%nid(jc) 
    299                WRITE(numout,*) 'prism_get_proto:   kstep', kstep 
    300                WRITE(numout,*) 'prism_get_proto:   info ', kinfo 
    301                WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(:,:,jc)) 
    302                WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(:,:,jc)) 
    303                WRITE(numout,*) '     -     Sum value is ', SUM(pdata(:,:,jc)) 
    304                WRITE(numout,*) '****************' 
     352         llfisrt = .TRUE. 
     353 
     354         DO jm = 1, srcv(kid)%ncplmodel 
     355 
     356            IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 
     357 
     358               CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo )          
     359                
     360               llaction =  kinfo == OASIS_Recvd   .OR. kinfo == OASIS_FromRest .OR.   & 
     361                  &        kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 
     362                
     363               IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 
     364                
     365               IF ( llaction ) THEN 
     366                   
     367                  kinfo = OASIS_Rcv 
     368                  IF( llfisrt ) THEN  
     369                     pdata(nldi:nlei,nldj:nlej,jc) =                                 exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm) 
     370                     llfisrt = .FALSE. 
     371                  ELSE 
     372                     pdata(nldi:nlei,nldj:nlej,jc) = pdata(nldi:nlei,nldj:nlej,jc) + exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm) 
     373                  ENDIF 
     374                   
     375                  IF ( ln_ctl ) THEN         
     376                     WRITE(numout,*) '****************' 
     377                     WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname 
     378                     WRITE(numout,*) 'oasis_get: ivarid '  , srcv(kid)%nid(jc,jm) 
     379                     WRITE(numout,*) 'oasis_get:   kstep', kstep 
     380                     WRITE(numout,*) 'oasis_get:   info ', kinfo 
     381                     WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(:,:,jc)) 
     382                     WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(:,:,jc)) 
     383                     WRITE(numout,*) '     -     Sum value is ', SUM(pdata(:,:,jc)) 
     384                     WRITE(numout,*) '****************' 
     385                  ENDIF 
     386                   
     387               ENDIF 
     388                
    305389            ENDIF 
    306390             
    307          ELSE 
    308             kinfo = OASIS_idle      
    309          ENDIF 
    310           
     391         ENDDO 
     392 
     393         !--- Fill the overlap areas and extra hallows (mpp) 
     394         !--- check periodicity conditions (all cases) 
     395         IF( .not. llfisrt )   CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn )    
     396  
    311397      ENDDO 
    312398      ! 
    313    END SUBROUTINE cpl_prism_rcv 
    314  
    315  
    316    INTEGER FUNCTION cpl_prism_freq( kid )   
     399   END SUBROUTINE cpl_rcv 
     400 
     401 
     402   INTEGER FUNCTION cpl_freq( kid )   
    317403      !!--------------------------------------------------------------------- 
    318       !!              ***  ROUTINE cpl_prism_freq  *** 
     404      !!              ***  ROUTINE cpl_freq  *** 
    319405      !! 
    320406      !! ** Purpose : - send back the coupling frequency for a particular field 
    321407      !!---------------------------------------------------------------------- 
    322       INTEGER,INTENT(in) ::   kid   ! variable index  
     408      INTEGER,INTENT(in) ::   kid   ! variable index 
     409      !! 
     410      INTEGER               :: info 
     411      INTEGER, DIMENSION(1) :: itmp 
    323412      !!---------------------------------------------------------------------- 
    324       cpl_prism_freq = ig_def_freq( kid ) 
    325       ! 
    326    END FUNCTION cpl_prism_freq 
    327  
    328  
    329    SUBROUTINE cpl_prism_finalize 
     413      CALL oasis_get_freqs(kid, 1, itmp, info) 
     414      cpl_freq = itmp(1) 
     415      ! 
     416   END FUNCTION cpl_freq 
     417 
     418 
     419   SUBROUTINE cpl_finalize 
    330420      !!--------------------------------------------------------------------- 
    331       !!              ***  ROUTINE cpl_prism_finalize  *** 
     421      !!              ***  ROUTINE cpl_finalize  *** 
    332422      !! 
    333423      !! ** Purpose : - Finalizes the coupling. If MPI_init has not been 
    334       !!      called explicitly before cpl_prism_init it will also close 
     424      !!      called explicitly before cpl_init it will also close 
    335425      !!      MPI communication. 
    336426      !!---------------------------------------------------------------------- 
    337427      ! 
    338428      DEALLOCATE( exfld ) 
    339       CALL prism_terminate_proto( nerror )          
    340       ! 
    341    END SUBROUTINE cpl_prism_finalize 
    342  
    343 #else 
    344    !!---------------------------------------------------------------------- 
    345    !!   Default case          Dummy module          Forced Ocean/Atmosphere 
    346    !!---------------------------------------------------------------------- 
    347    USE in_out_manager               ! I/O manager 
    348    LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .FALSE.   !: coupled flag 
    349    PUBLIC cpl_prism_init 
    350    PUBLIC cpl_prism_finalize 
    351 CONTAINS 
    352    SUBROUTINE cpl_prism_init (kl_comm)  
    353       INTEGER, INTENT(out)   :: kl_comm       ! local communicator of the model 
    354       kl_comm = -1 
    355       WRITE(numout,*) 'cpl_prism_init: Error you sould not be there...' 
    356    END SUBROUTINE cpl_prism_init 
    357    SUBROUTINE cpl_prism_finalize 
    358       WRITE(numout,*) 'cpl_prism_finalize: Error you sould not be there...' 
    359    END SUBROUTINE cpl_prism_finalize 
     429      IF (nstop == 0) THEN 
     430         CALL oasis_terminate( nerror )          
     431      ELSE 
     432         CALL oasis_abort( ncomp_id, "cpl_finalize", "NEMO ABORT STOP" ) 
     433      ENDIF        
     434      ! 
     435   END SUBROUTINE cpl_finalize 
     436 
     437#if ! defined key_oasis3 
     438 
     439   !!---------------------------------------------------------------------- 
     440   !!   No OASIS Library          OASIS3 Dummy module... 
     441   !!---------------------------------------------------------------------- 
     442 
     443   SUBROUTINE oasis_init_comp(k1,cd1,k2) 
     444      CHARACTER(*), INTENT(in   ) ::  cd1 
     445      INTEGER     , INTENT(  out) ::  k1,k2 
     446      k1 = -1 ; k2 = -1 
     447      WRITE(numout,*) 'oasis_init_comp: Error you sould not be there...', cd1 
     448   END SUBROUTINE oasis_init_comp 
     449 
     450   SUBROUTINE oasis_abort(k1,cd1,cd2) 
     451      INTEGER     , INTENT(in   ) ::  k1 
     452      CHARACTER(*), INTENT(in   ) ::  cd1,cd2 
     453      WRITE(numout,*) 'oasis_abort: Error you sould not be there...', cd1, cd2 
     454   END SUBROUTINE oasis_abort 
     455 
     456   SUBROUTINE oasis_get_localcomm(k1,k2) 
     457      INTEGER     , INTENT(  out) ::  k1,k2 
     458      k1 = -1 ; k2 = -1 
     459      WRITE(numout,*) 'oasis_get_localcomm: Error you sould not be there...' 
     460   END SUBROUTINE oasis_get_localcomm 
     461 
     462   SUBROUTINE oasis_def_partition(k1,k2,k3) 
     463      INTEGER     , INTENT(  out) ::  k1,k3 
     464      INTEGER     , INTENT(in   ) ::  k2(5) 
     465      k1 = k2(1) ; k3 = k2(5) 
     466      WRITE(numout,*) 'oasis_def_partition: Error you sould not be there...' 
     467   END SUBROUTINE oasis_def_partition 
     468 
     469   SUBROUTINE oasis_def_var(k1,cd1,k2,k3,k4,k5,k6,k7) 
     470      CHARACTER(*), INTENT(in   ) ::  cd1 
     471      INTEGER     , INTENT(in   ) ::  k2,k3(2),k4,k5(2,2),k6 
     472      INTEGER     , INTENT(  out) ::  k1,k7 
     473      k1 = -1 ; k7 = -1 
     474      WRITE(numout,*) 'oasis_def_var: Error you sould not be there...', cd1 
     475   END SUBROUTINE oasis_def_var 
     476 
     477   SUBROUTINE oasis_enddef(k1) 
     478      INTEGER     , INTENT(  out) ::  k1 
     479      k1 = -1 
     480      WRITE(numout,*) 'oasis_enddef: Error you sould not be there...' 
     481   END SUBROUTINE oasis_enddef 
     482   
     483   SUBROUTINE oasis_put(k1,k2,p1,k3) 
     484      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::  p1 
     485      INTEGER                 , INTENT(in   ) ::  k1,k2 
     486      INTEGER                 , INTENT(  out) ::  k3 
     487      k3 = -1 
     488      WRITE(numout,*) 'oasis_put: Error you sould not be there...' 
     489   END SUBROUTINE oasis_put 
     490 
     491   SUBROUTINE oasis_get(k1,k2,p1,k3) 
     492      REAL(wp), DIMENSION(:,:), INTENT(  out) ::  p1 
     493      INTEGER                 , INTENT(in   ) ::  k1,k2 
     494      INTEGER                 , INTENT(  out) ::  k3 
     495      p1(1,1) = -1. ; k3 = -1 
     496      WRITE(numout,*) 'oasis_get: Error you sould not be there...' 
     497   END SUBROUTINE oasis_get 
     498 
     499   SUBROUTINE oasis_get_freqs(k1,k2,k3,k4) 
     500      INTEGER              , INTENT(in   ) ::  k1,k2 
     501      INTEGER, DIMENSION(1), INTENT(  out) ::  k3 
     502      INTEGER              , INTENT(  out) ::  k4 
     503      k3(1) = k1 ; k4 = k2 
     504      WRITE(numout,*) 'oasis_get_freqs: Error you sould not be there...' 
     505   END SUBROUTINE oasis_get_freqs 
     506 
     507   SUBROUTINE oasis_terminate(k1) 
     508      INTEGER     , INTENT(  out) ::  k1 
     509      k1 = -1 
     510      WRITE(numout,*) 'oasis_terminate: Error you sould not be there...' 
     511   END SUBROUTINE oasis_terminate 
     512    
    360513#endif 
    361514 
Note: See TracChangeset for help on using the changeset viewer.