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 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90 – NEMO

Ignore:
Timestamp:
2011-03-30T17:58:35+02:00 (13 years ago)
Author:
rblod
Message:

First attempt to put dynamic allocation on the trunk

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90

    r2528 r2715  
    66   !!===================================================================== 
    77   !! History :    
    8    !!   9.0  !  04-06  (R. Redler, NEC Laboratories Europe, St Augustin, Germany) Original code 
    9    !!   " "  !  04-11  (R. Redler, NEC Laboratories Europe; N. Keenlyside, W. Park, IFM-GEOMAR, Kiel, Germany) revision 
     8   !!   9.0  !  04-06  (R. Redler, NEC Laboratories Europe, Germany) Original code 
     9   !!   " "  !  04-11  (R. Redler, NEC Laboratories Europe; N. Keenlyside, W. Park, IFM-GEOMAR, Germany) revision 
    1010   !!   " "  !  04-11  (V. Gayler, MPI M&D) Grid writing 
    1111   !!   " "  !  05-08  (R. Redler, W. Park) frld initialization, paral(2) revision 
    … …  
    1717   !!---------------------------------------------------------------------- 
    1818   !!   'key_oasis3'                    coupled Ocean/Atmosphere via OASIS3 
    19    !!---------------------------------------------------------------------- 
    2019   !!---------------------------------------------------------------------- 
    2120   !!   cpl_prism_init     : initialization of coupled mode communication 
    … …  
    3332   USE dom_oce                      ! ocean space and time domain 
    3433   USE in_out_manager               ! I/O manager 
    35    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     34   USE lbclnk                       ! ocean lateral boundary conditions (or mpp link) 
     35 
    3636   IMPLICIT NONE 
    3737   PRIVATE 
    38 ! 
    39    LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .TRUE.   ! coupled flag 
    40    INTEGER, PUBLIC            :: OASIS_Rcv  = 1    ! return code if received field 
    41    INTEGER, PUBLIC            :: OASIS_idle = 0    ! return code if nothing done by oasis 
    42    INTEGER                    :: ncomp_id          ! id returned by prism_init_comp 
    43    INTEGER                    :: nerror            ! return error code 
    44  
    45    INTEGER, PARAMETER :: nmaxfld=40    ! Maximum number of coupling fields 
     38 
     39   PUBLIC   cpl_prism_init 
     40   PUBLIC   cpl_prism_define 
     41   PUBLIC   cpl_prism_snd 
     42   PUBLIC   cpl_prism_rcv 
     43   PUBLIC   cpl_prism_freq 
     44   PUBLIC   cpl_prism_finalize 
     45 
     46   LOGICAL, PUBLIC, PARAMETER ::   lk_cpl = .TRUE.   !: coupled flag 
     47   INTEGER, PUBLIC            ::   OASIS_Rcv  = 1    !: return code if received field 
     48   INTEGER, PUBLIC            ::   OASIS_idle = 0    !: return code if nothing done by oasis 
     49   INTEGER                    ::   ncomp_id          ! id returned by prism_init_comp 
     50   INTEGER                    ::   nerror            ! return error code 
     51 
     52   INTEGER, PARAMETER ::   nmaxfld=40    ! Maximum number of coupling fields 
    4653    
    47    TYPE, PUBLIC ::   FLD_CPL            ! Type for coupling field information 
     54   TYPE, PUBLIC ::   FLD_CPL            !: Type for coupling field information 
    4855      LOGICAL            ::   laction   ! To be coupled or not 
    4956      CHARACTER(len = 8) ::   clname    ! Name of the coupling field    
    … …  
    5360   END TYPE FLD_CPL 
    5461 
    55    TYPE(FLD_CPL), DIMENSION(nmaxfld), PUBLIC :: srcv, ssnd   ! Coupling fields 
    56  
    57    REAL(wp), DIMENSION(:,:), ALLOCATABLE :: exfld  ! Temporary buffer for receiving 
    58  
    59    !! Routine accessibility 
    60    PUBLIC cpl_prism_init 
    61    PUBLIC cpl_prism_define 
    62    PUBLIC cpl_prism_snd 
    63    PUBLIC cpl_prism_rcv 
    64    PUBLIC cpl_prism_freq 
    65    PUBLIC cpl_prism_finalize 
     62   TYPE(FLD_CPL), DIMENSION(nmaxfld), PUBLIC ::   srcv, ssnd   !: Coupling fields 
     63 
     64   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   exfld   ! Temporary buffer for receiving 
    6665 
    6766   !!---------------------------------------------------------------------- 
    6867   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    6968   !! $Id$ 
    70    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    71    !!---------------------------------------------------------------------- 
    72  
     69   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     70   !!---------------------------------------------------------------------- 
    7371CONTAINS 
    7472 
    75    SUBROUTINE cpl_prism_init (kl_comm)  
    76  
     73   SUBROUTINE cpl_prism_init( kl_comm ) 
    7774      !!------------------------------------------------------------------- 
    7875      !!             ***  ROUTINE cpl_prism_init  *** 
    … …  
    8380      !! ** Method  :   OASIS3 MPI communication  
    8481      !!-------------------------------------------------------------------- 
    85       INTEGER, INTENT(   OUT )   :: kl_comm       ! local communicator of the model 
     82      INTEGER, INTENT(out) ::   kl_comm   ! local communicator of the model 
    8683      !!-------------------------------------------------------------------- 
    8784 
    … …  
    103100      IF ( nerror /= PRISM_Ok ) & 
    104101         CALL prism_abort_proto (ncomp_id, 'cpl_prism_init','Failure in prism_get_localcomm_proto' ) 
    105  
     102      ! 
    106103   END SUBROUTINE cpl_prism_init 
    107104 
    108105 
    109    SUBROUTINE cpl_prism_define (krcv, ksnd) 
    110  
     106   SUBROUTINE cpl_prism_define( krcv, ksnd ) 
    111107      !!------------------------------------------------------------------- 
    112108      !!             ***  ROUTINE cpl_prism_define  *** 
    … …  
    117113      !! ** Method  :   OASIS3 MPI communication  
    118114      !!-------------------------------------------------------------------- 
    119       INTEGER, INTENT( IN    )   :: krcv, ksnd     ! Number of received and sent coupling fields 
    120       ! 
    121       INTEGER                    :: id_part 
    122       INTEGER                    :: paral(5)       ! OASIS3 box partition 
    123       INTEGER                    :: ishape(2,2)    ! shape of arrays passed to PSMILe 
    124       INTEGER                    :: ji             ! local loop indicees 
    125       !! 
     115      INTEGER, INTENT(in) ::   krcv, ksnd     ! Number of received and sent coupling fields 
     116      ! 
     117      INTEGER :: id_part 
     118      INTEGER :: paral(5)       ! OASIS3 box partition 
     119      INTEGER :: ishape(2,2)    ! shape of arrays passed to PSMILe 
     120      INTEGER :: ji             ! local loop indicees 
    126121      !!-------------------------------------------------------------------- 
    127122 
    … …  
    142137      ! 
    143138      ALLOCATE(exfld(nlei-nldi+1, nlej-nldj+1), stat = nerror) 
    144       IF (nerror > 0) THEN 
    145          CALL prism_abort_proto ( ncomp_id, 'cpl_prism_define', 'Failure in allocating exfld') 
    146          RETURN 
     139      IF( nerror > 0 ) THEN 
     140         CALL prism_abort_proto ( ncomp_id, 'cpl_prism_define', 'Failure in allocating exfld')   ;   RETURN 
    147141      ENDIF 
    148142      ! 
    … …  
    197191       
    198192      CALL prism_enddef_proto(nerror) 
    199       IF ( nerror /= PRISM_Ok )   CALL prism_abort_proto ( ncomp_id, 'cpl_prism_define', 'Failure in prism_enddef') 
    200        
     193      IF( nerror /= PRISM_Ok )   CALL prism_abort_proto ( ncomp_id, 'cpl_prism_define', 'Failure in prism_enddef') 
     194      ! 
    201195   END SUBROUTINE cpl_prism_define 
    202196    
    203197    
    204198   SUBROUTINE cpl_prism_snd( kid, kstep, pdata, kinfo ) 
    205  
    206199      !!--------------------------------------------------------------------- 
    207200      !!              ***  ROUTINE cpl_prism_snd  *** 
    … …  
    210203      !!      like sst or ice cover to the coupler or remote application. 
    211204      !!---------------------------------------------------------------------- 
    212       !! * Arguments 
    213       !! 
    214       INTEGER,                      INTENT( IN    )   :: kid       ! variable index in the array 
    215       INTEGER,                      INTENT(   OUT )   :: kinfo     ! OASIS3 info argument 
    216       INTEGER,                      INTENT( IN    )   :: kstep     ! ocean time-step in seconds 
    217       REAL(wp), DIMENSION(jpi,jpj), INTENT( IN    )   :: pdata 
    218       !! 
    219       !! 
     205      INTEGER                 , INTENT(in   ) ::   kid       ! variable index in the array 
     206      INTEGER                 , INTENT(  out) ::   kinfo     ! OASIS3 info argument 
     207      INTEGER                 , INTENT(in   ) ::   kstep     ! ocean time-step in seconds 
     208      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   pdata 
    220209      !!-------------------------------------------------------------------- 
    221210      ! 
    … …  
    236225            WRITE(numout,*) '     -     Sum value is ', SUM(pdata) 
    237226            WRITE(numout,*) '****************' 
    238         ENDIF 
    239      ENDIF 
     227         ENDIF 
     228      ENDIF 
     229      ! 
    240230    END SUBROUTINE cpl_prism_snd 
    241231 
    242232 
    243233   SUBROUTINE cpl_prism_rcv( kid, kstep, pdata, kinfo ) 
    244  
    245234      !!--------------------------------------------------------------------- 
    246235      !!              ***  ROUTINE cpl_prism_rcv  *** 
    … …  
    249238      !!      like stresses and fluxes from the coupler or remote application. 
    250239      !!---------------------------------------------------------------------- 
    251       INTEGER,                      INTENT( IN    )   :: kid       ! variable index in the array 
    252       INTEGER,                      INTENT( IN    )   :: kstep     ! ocean time-step in seconds 
    253       REAL(wp), DIMENSION(jpi,jpj), INTENT( INOUT )   :: pdata     ! IN to keep the value if nothing is done 
    254       INTEGER,                      INTENT(   OUT )   :: kinfo     ! OASIS3 info argument 
    255       !! 
    256       LOGICAL                :: llaction 
     240      INTEGER                 , INTENT(in   ) ::  kid       ! variable index in the array 
     241      INTEGER                 , INTENT(in   ) ::  kstep     ! ocean time-step in seconds 
     242      REAL(wp), DIMENSION(:,:), INTENT(inout) ::  pdata     ! IN to keep the value if nothing is done 
     243      INTEGER                 , INTENT(  out) ::  kinfo     ! OASIS3 info argument 
     244      !! 
     245      LOGICAL ::  llaction 
    257246      !!-------------------------------------------------------------------- 
    258247      ! 
    … …  
    291280         kinfo = OASIS_idle      
    292281      ENDIF 
    293  
     282      ! 
    294283   END SUBROUTINE cpl_prism_rcv 
    295284 
    296285 
    297    FUNCTION cpl_prism_freq( kid )   
    298  
     286   INTEGER FUNCTION cpl_prism_freq( kid )   
    299287      !!--------------------------------------------------------------------- 
    300288      !!              ***  ROUTINE cpl_prism_freq  *** 
    … …  
    302290      !! ** Purpose : - send back the coupling frequency for a particular field 
    303291      !!---------------------------------------------------------------------- 
    304       INTEGER,INTENT( IN )   :: kid              ! variable index  
    305       INTEGER                :: cpl_prism_freq   ! coupling frequency 
     292      INTEGER,INTENT(in) ::   kid   ! variable index  
     293      !!---------------------------------------------------------------------- 
    306294      cpl_prism_freq = ig_def_freq( kid ) 
    307  
     295      ! 
    308296   END FUNCTION cpl_prism_freq 
    309297 
    310298 
    311299   SUBROUTINE cpl_prism_finalize 
    312  
    313300      !!--------------------------------------------------------------------- 
    314301      !!              ***  ROUTINE cpl_prism_finalize  *** 
    … …  
    318305      !!      MPI communication. 
    319306      !!---------------------------------------------------------------------- 
    320  
    321       DEALLOCATE(exfld) 
    322       CALL prism_terminate_proto ( nerror )          
    323  
     307      ! 
     308      DEALLOCATE( exfld ) 
     309      CALL prism_terminate_proto( nerror )          
     310      ! 
    324311   END SUBROUTINE cpl_prism_finalize 
    325312 
    326313#else 
    327  
    328    !!---------------------------------------------------------------------- 
    329    !!   Default case                                Forced Ocean/Atmosphere 
    330    !!---------------------------------------------------------------------- 
    331    !!   Empty module 
     314   !!---------------------------------------------------------------------- 
     315   !!   Default case          Dummy module          Forced Ocean/Atmosphere 
    332316   !!---------------------------------------------------------------------- 
    333317   USE in_out_manager               ! I/O manager 
    … …  
    335319   PUBLIC cpl_prism_init 
    336320   PUBLIC cpl_prism_finalize 
    337  
    338321CONTAINS 
    339  
    340322   SUBROUTINE cpl_prism_init (kl_comm)  
    341       INTEGER, INTENT(   OUT )   :: kl_comm       ! local communicator of the model 
     323      INTEGER, INTENT(out)   :: kl_comm       ! local communicator of the model 
    342324      kl_comm = -1 
    343325      WRITE(numout,*) 'cpl_prism_init: Error you sould not be there...' 
    344326   END SUBROUTINE cpl_prism_init 
    345  
    346327   SUBROUTINE cpl_prism_finalize 
    347328      WRITE(numout,*) 'cpl_prism_finalize: Error you sould not be there...' 
    348329   END SUBROUTINE cpl_prism_finalize 
    349  
    350330#endif 
    351331 
     332   !!===================================================================== 
    352333END MODULE cpl_oasis3 
Note: See TracChangeset for help on using the changeset viewer.