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 532 for trunk/NEMO/OPA_SRC – NEMO

Changeset 532 for trunk/NEMO/OPA_SRC


Ignore:
Timestamp:
2006-10-20T08:36:42+02:00 (18 years ago)
Author:
opalod
Message:

nemo_v1_update_76 : CT : add OASIS[3-4] interfaces to build coupled configurations

Location:
trunk/NEMO/OPA_SRC
Files:
5 added
4 deleted
4 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMO/OPA_SRC/SBC/flxmod.F90

    r473 r532  
    1414   USE ocfzpt          ! ocean freezing point 
    1515 
     16#if defined key_oasis3 || defined key_oasis4 
     17#if defined key_oasis3 
     18   USE cpl_oasis3      ! OASIS3 coupling (to ECHAM5) 
     19#else if defined key_oasis4 
     20   USE cpl_oasis4      ! OASIS4 coupling (to ECHAM5) 
     21#endif 
     22   USE flx_oce, only : dqns_ice , & ! : derivative of non solar heat flux on sea ice 
     23                       qsr_oce  , & ! : solar flux over ocean 
     24                       qnsr_oce , & ! : total non solar heat flux (longwave downward radiation) over ocean 
     25                       qsr_ice  , & ! : solar flux over ice 
     26                       qnsr_ice , & ! : total non solar heat flux (Longwave downward radiation) over ice 
     27                       tn_ice   , & ! : ice surface temperature 
     28                       alb_ice  , & ! : albedo of ice 
     29                       sprecip  , & ! : solid (snow) precipitation over water (!) what about ice? 
     30                       tprecip  , & ! : total precipitation ( or liquid precip minus evaporation in coupled mode) 
     31                       calving  , & ! : calving 
     32                       rrunoff  , & ! : monthly runoff (kg/m2/s) 
     33                       fr1_i0   , & ! : 1st part of the fraction of sol.rad. which penetrate inside the ice cover 
     34                       fr2_i0       ! : 2nd part of the fraction of sol.rad. which penetrate inside the ice cover 
     35 
     36   USE ice, only    : hicif ,     & ! : ice thickness 
     37                      frld  ,     & ! : leads fraction = 1-a/totalarea 
     38                      hsnif  ,    & ! : snow thickness 
     39                      u_ice , v_ice ! : ice velocity 
     40 
     41   USE ice_oce, only : sst_io      ! : sea surface temperature 
     42 
     43#if defined key_cpl_ocevel 
     44   USE geo2ocean, only : repere, repcmo 
     45#endif 
     46#endif 
    1647   IMPLICIT NONE 
    1748   PRIVATE 
    1849 
     50#if defined key_oasis3 || defined key_oasis4 
     51   REAL(wp), DIMENSION(jpi,jpj) :: catm 
     52#endif 
    1953   !! * Routine accessibility 
    2054   PUBLIC flx       ! routine called by step.F90 
    … …  
    6599#  include "flx_forced_daily.h90" 
    66100 
    67 #elif defined key_coupled 
    68 # if defined key_ice_lim 
     101#elif defined key_oasis3  ||  defined key_oasis4 
    69102   !!---------------------------------------------------------------------- 
    70    !!   'key_coupled'  and                          Coupled Ocan/Atmosphere 
     103   !!   'key_oasis3'  or 'key_oasis4' and           Coupled Ocan/Atmosphere 
    71104   !!   'key_ice_lim'                               with  LIM sea-ice model 
    72105   !!---------------------------------------------------------------------- 
    73 #  include "flx_coupled_ice.h90" 
    74  
    75 # else 
    76    !!---------------------------------------------------------------------- 
    77    !!   'key_flx_coupled'  and                      Coupled Ocan/Atmosphere 
    78    !!   Default option                              without   sea-ice model 
    79    !!---------------------------------------------------------------------- 
    80 #  include "flx_coupled_noice.h90" 
    81  
    82 # endif 
     106#  include "flx_oasis_ice.h90" 
    83107#else 
    84108   !!---------------------------------------------------------------------- 

  • trunk/NEMO/OPA_SRC/SBC/taumod.F90

    r434 r532  
    1515   USE lbclnk          !  
    1616 
     17#if defined key_oasis3 || defined key_oasis4 
     18   USE geo2ocean, only : repcmo 
     19   USE ice, only       : frld       ! : leads fraction = 1-a/totalarea 
     20#if defined key_oasis3 
     21   USE cpl_oasis3      ! OASIS3 coupling (to ECHAM5) 
     22#else if defined key_oasis4 
     23   USE cpl_oasis4      ! OASIS4 coupling (to ECHAM5) 
     24#endif 
     25#endif 
    1726   IMPLICIT NONE 
    1827   PRIVATE 
    … …  
    4857#   include "tau_forced_daily.h90" 
    4958 
    50 #elif defined key_coupled 
     59#elif defined key_oasis3  ||  defined key_oasis4 
    5160   ! Coupled case : stress at the coupling frequency 
    52 # if defined key_ice_lim 
    53    !!---------------------------------------------------------------------- 
    54    !!   'key_coupled'                              Coupled Ocean/Atmosphere 
     61   !!---------------------------------------------------------------------- 
     62   !!   'key_oasis3' or 'key_oasis4' and           Coupled Ocean/Atmosphere 
    5563   !!   'key_ice_lim'                                   LIM sea-ice 
    5664   !!---------------------------------------------------------------------- 
    5765   ! New way: 3D referential link to the earth (avoid north pole pb) 
    5866   ! (3 component stress defined at U- and V-points) 
    59 #  include "tau_coupled_ice.h90" 
    60 # else 
    61    !!---------------------------------------------------------------------- 
    62    !!   'key_coupled'                              Coupled Ocean/Atmosphere 
    63    !!   Default case                                  NO sea-ice 
    64    !!---------------------------------------------------------------------- 
    65    ! old fashion: geographical referential 
    66    ! (zonal and meridional stress defined at U- and V-points) 
    67 #  include "tau_coupled.h90" 
    68 # endif 
     67#  include "tau_oasis_ice.h90" 
    6968#else 
    7069   !!---------------------------------------------------------------------- 

  • trunk/NEMO/OPA_SRC/lib_mpp.F90

    r524 r532  
    4545   !!        !  04  (R. Bourdalle Badie)  isend option in mpi 
    4646   !!        !  05  (G. Madec, S. Masson)  npolj=5,6 F-point & ice cases 
     47   !!        !  05  (R. Redler) Replacement of MPI_COMM_WORLD except for MPI_Abort 
    4748   !!---------------------------------------------------------------------- 
    4849   !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    … …  
    6061   PUBLIC  mpp_lbc_north_e, mpp_minloc, mpp_maxloc, mpp_lnk_3d, mpp_lnk_2d, mpp_lnk_3d_gather, mpp_lnk_2d_e, mpplnks 
    6162   PUBLIC  mpprecv, mppsend, mppscatter, mppgather, mppobc, mpp_ini_north, mppstop, mppsync 
     63#if defined key_oasis3 || defined key_oasis4 
     64   PUBLIC  size, rank 
     65#endif 
    6266 
    6367   !! * Interfaces 
    … …  
    107111   INTEGER ::   & 
    108112      size,     &  ! number of process 
    109       rank         ! process number  [ 0 - size-1 ] 
     113      rank,     &  ! process number  [ 0 - size-1 ] 
     114      mpi_comm_opa ! opa local communicator 
    110115 
    111116   ! variables used in case of north fold condition in mpp_mpi with jpni > 1 
    … …  
    117122      njmppmax             ! value of njmpp for the processors of the northern line 
    118123   INTEGER ::      &       ! 
    119       north_root           ! number (in the comm_world) of proc 0 in the northern comm 
     124      north_root           ! number (in the comm_opa) of proc 0 in the northern comm 
    120125   INTEGER, DIMENSION(:), ALLOCATABLE ::   & 
    121126      nrank_north          ! dimension ndim_rank_north, number of the procs belonging to ncomm_north 
    … …  
    272277CONTAINS 
    273278 
    274    FUNCTION mynode() 
     279   FUNCTION mynode(localComm) 
    275280      !!---------------------------------------------------------------------- 
    276281      !!                  ***  routine mynode  *** 
    … …  
    281286#if defined key_mpp_mpi 
    282287      !! * Local variables   (MPI version) 
    283       INTEGER ::   mynode, ierr 
     288      INTEGER ::   mynode, ierr, code 
     289      LOGICAL ::   mpi_was_called 
     290      INTEGER,OPTIONAL ::   localComm 
    284291      NAMELIST/nam_mpp/ c_mpi_send 
    285292      !!---------------------------------------------------------------------- 
    … …  
    300307      IF( Agrif_Root() ) THEN 
    301308#endif 
    302          SELECT CASE ( c_mpi_send ) 
    303          CASE ( 'S' )                ! Standard mpi send (blocking) 
    304             WRITE(numout,*) '           Standard blocking mpi send (send)' 
    305             CALL mpi_init( ierr ) 
    306          CASE ( 'B' )                ! Buffer mpi send (blocking) 
    307             WRITE(numout,*) '           Buffer blocking mpi send (bsend)' 
    308             CALL mpi_init_opa( ierr ) 
    309          CASE ( 'I' )                ! Immediate mpi send (non-blocking send) 
    310             WRITE(numout,*) '           Immediate non-blocking send (isend)' 
    311             l_isend = .TRUE. 
    312             CALL mpi_init( ierr ) 
    313          CASE DEFAULT 
    314             WRITE(numout,cform_err) 
    315             WRITE(numout,*) '           bad value for c_mpi_send = ', c_mpi_send 
    316             nstop = nstop + 1 
    317          END SELECT 
    318  
     309         CALL mpi_initialized ( mpi_was_called, code ) 
     310         IF( code /= MPI_SUCCESS ) THEN 
     311            CALL ctl_stop( ' lib_mpp: Error in routine mpi_initialized' ) 
     312            CALL mpi_abort( mpi_comm_world, code, ierr ) 
     313         ENDIF 
     314 
     315         IF( PRESENT(localComm) .and. mpi_was_called ) THEN 
     316            mpi_comm_opa = localComm 
     317            SELECT CASE ( c_mpi_send ) 
     318            CASE ( 'S' )                ! Standard mpi send (blocking) 
     319               WRITE(numout,*) '           Standard blocking mpi send (send)' 
     320            CASE ( 'B' )                ! Buffer mpi send (blocking) 
     321               WRITE(numout,*) '           Buffer blocking mpi send (bsend)' 
     322               CALL mpi_init_opa( ierr ) 
     323            CASE ( 'I' )                ! Immediate mpi send (non-blocking send) 
     324               WRITE(numout,*) '           Immediate non-blocking send (isend)' 
     325               l_isend = .TRUE. 
     326            CASE DEFAULT 
     327               WRITE(numout,cform_err) 
     328               WRITE(numout,*) '           bad value for c_mpi_send = ', c_mpi_send 
     329               nstop = nstop + 1 
     330            END SELECT 
     331         ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN 
     332            WRITE(numout,*) ' lib_mpp: You cannot provide a local communicator ' 
     333            WRITE(numout,*) '          without calling MPI_Init before ! ' 
     334         ELSE 
     335            SELECT CASE ( c_mpi_send ) 
     336            CASE ( 'S' )                ! Standard mpi send (blocking) 
     337               WRITE(numout,*) '           Standard blocking mpi send (send)' 
     338               CALL mpi_init( ierr ) 
     339            CASE ( 'B' )                ! Buffer mpi send (blocking) 
     340               WRITE(numout,*) '           Buffer blocking mpi send (bsend)' 
     341               CALL mpi_init_opa( ierr ) 
     342            CASE ( 'I' )                ! Immediate mpi send (non-blocking send) 
     343               WRITE(numout,*) '           Immediate non-blocking send (isend)' 
     344               l_isend = .TRUE. 
     345               CALL mpi_init( ierr ) 
     346            CASE DEFAULT 
     347               WRITE(ctmp1,*) '           bad value for c_mpi_send = ', c_mpi_send 
     348               CALL ctl_stop( ctmp1 ) 
     349            END SELECT 
     350 
     351            CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code) 
     352            IF( code /= MPI_SUCCESS ) THEN 
     353               CALL ctl_stop( ' lib_mpp: Error in routine mpi_comm_dup' ) 
     354               CALL mpi_abort( mpi_comm_world, code, ierr ) 
     355            ENDIF 
     356            ! 
     357         ENDIF 
    319358#if defined key_agrif 
    320      ELSE 
     359      ELSE 
    321360         SELECT CASE ( c_mpi_send ) 
    322361         CASE ( 'S' )                ! Standard mpi send (blocking) 
    … …  
    335374#endif 
    336375 
    337       CALL mpi_comm_rank( mpi_comm_world, rank, ierr ) 
    338       CALL mpi_comm_size( mpi_comm_world, size, ierr ) 
     376      CALL mpi_comm_rank( mpi_comm_opa, rank, ierr ) 
     377      CALL mpi_comm_size( mpi_comm_opa, size, ierr ) 
    339378      mynode = rank 
    340379#else 
    … …  
    27952834      CASE ( 'S' )                ! Standard mpi send (blocking) 
    27962835         CALL mpi_send ( pmess, kbytes, mpi_double_precision, kdest, ktyp,   & 
    2797             &                          mpi_comm_world, iflag ) 
     2836            &                          mpi_comm_opa, iflag ) 
    27982837      CASE ( 'B' )                ! Buffer mpi send (blocking) 
    27992838         CALL mpi_bsend( pmess, kbytes, mpi_double_precision, kdest, ktyp,   & 
    2800             &                          mpi_comm_world, iflag ) 
     2839            &                          mpi_comm_opa, iflag ) 
    28012840      CASE ( 'I' )                ! Immediate mpi send (non-blocking send) 
    28022841         ! Be carefull, one more argument here : the mpi request identifier.. 
    28032842         CALL mpi_isend( pmess, kbytes, mpi_double_precision, kdest, ktyp,   & 
    2804             &                          mpi_comm_world, md_req, iflag ) 
     2843            &                          mpi_comm_opa, md_req, iflag ) 
    28052844      END SELECT 
    28062845#endif 
    … …  
    28302869 
    28312870      CALL mpi_recv( pmess, kbytes, mpi_double_precision, mpi_any_source, ktyp,   & 
    2832          &                          mpi_comm_world, istatus, iflag ) 
     2871         &                          mpi_comm_opa, istatus, iflag ) 
    28332872#endif 
    28342873 
    … …  
    28642903      itaille=jpi*jpj 
    28652904      CALL mpi_gather( ptab, itaille, mpi_double_precision, pio, itaille,   & 
    2866          &                            mpi_double_precision, kp , mpi_comm_world, ierror )  
     2905         &                            mpi_double_precision, kp , mpi_comm_opa, ierror )  
    28672906#endif 
    28682907 
    … …  
    28982937 
    28992938      CALL mpi_scatter( pio, itaille, mpi_double_precision, ptab, itaille,   & 
    2900          &                            mpi_double_precision, kp, mpi_comm_world, ierror ) 
     2939         &                            mpi_double_precision, kp, mpi_comm_opa, ierror ) 
    29012940#endif 
    29022941 
    … …  
    29592998      CALL mpi_op_create( lc_isl, lcommute, mpi_isl, ierror ) 
    29602999      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer   & 
    2961            , mpi_isl, mpi_comm_world, ierror ) 
     3000           , mpi_isl, mpi_comm_opa, ierror ) 
    29623001      ktab(:) = iwork(:) 
    29633002#endif 
    … …  
    30133052      CALL mpi_op_create(lc_isl,lcommute,mpi_isl,ierror) 
    30143053      CALL mpi_allreduce(ktab, iwork, 1,mpi_integer   & 
    3015            ,mpi_isl,mpi_comm_world,ierror) 
     3054           ,mpi_isl,mpi_comm_opa,ierror) 
    30163055      ktab = iwork 
    30173056#endif 
    … …  
    30643103   
    30653104      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer,   & 
    3066            &                mpi_min, mpi_comm_world, ierror ) 
     3105           &                mpi_min, mpi_comm_opa, ierror ) 
    30673106   
    30683107      ktab(:) = iwork(:) 
    … …  
    31123151   
    31133152      CALL mpi_allreduce(ktab,iwork, 1,mpi_integer   & 
    3114            &              ,mpi_min,mpi_comm_world,ierror) 
     3153           &              ,mpi_min,mpi_comm_opa,ierror) 
    31153154   
    31163155      ktab = iwork 
    … …  
    31663205   
    31673206      CALL mpi_allreduce(ktab, iwork,kdim,mpi_integer   & 
    3168            ,mpi_sum,mpi_comm_world,ierror) 
     3207           ,mpi_sum,mpi_comm_opa,ierror) 
    31693208   
    31703209      ktab(:) = iwork(:) 
    … …  
    32093248 
    32103249    CALL mpi_allreduce(ktab,iwork, 1,mpi_integer   & 
    3211          ,mpi_sum,mpi_comm_world,ierror) 
     3250         ,mpi_sum,mpi_comm_opa,ierror) 
    32123251 
    32133252    ktab = iwork 
    … …  
    32773316    CALL mpi_op_create(lc_isl,lcommute,mpi_isl,ierror) 
    32783317    CALL mpi_allreduce(ptab, zwork,kdim,mpi_double_precision   & 
    3279          ,mpi_isl,mpi_comm_world,ierror) 
     3318         ,mpi_isl,mpi_comm_opa,ierror) 
    32803319    ptab(:) = zwork(:) 
    32813320 
    … …  
    33353374      CALL mpi_op_create( lc_isl, lcommute, mpi_isl, ierror ) 
    33363375      CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision,   & 
    3337          &                                mpi_isl  , mpi_comm_world, ierror ) 
     3376         &                                mpi_isl  , mpi_comm_opa, ierror ) 
    33383377      ptab = zwork 
    33393378 
    … …  
    34013440 
    34023441    CALL mpi_allreduce(ptab, zwork,kdim,mpi_double_precision   & 
    3403          ,mpi_max,mpi_comm_world,ierror) 
     3442         ,mpi_max,mpi_comm_opa,ierror) 
    34043443    ptab(:) = zwork(:) 
    34053444 
    … …  
    34453484 
    34463485    CALL mpi_allreduce( ptab, zwork  , 1             , mpi_double_precision,   & 
    3447        &                      mpi_max, mpi_comm_world, ierror     ) 
     3486       &                      mpi_max, mpi_comm_opa, ierror     ) 
    34483487    ptab = zwork 
    34493488 
    … …  
    34983537 
    34993538    CALL mpi_allreduce(ptab, zwork,kdim,mpi_double_precision   & 
    3500          ,mpi_min,mpi_comm_world,ierror) 
     3539         ,mpi_min,mpi_comm_opa,ierror) 
    35013540    ptab(:) = zwork(:) 
    35023541 
    … …  
    35433582 
    35443583    CALL mpi_allreduce( ptab, zwork, 1,mpi_double_precision   & 
    3545          &               ,mpi_min,mpi_comm_world,ierror) 
     3584         &               ,mpi_min,mpi_comm_opa,ierror) 
    35463585    ptab = zwork 
    35473586 
    … …  
    35963635 
    35973636    CALL mpi_allreduce(ptab, zwork,kdim,mpi_double_precision   & 
    3598          &              ,mpi_sum,mpi_comm_world,ierror) 
     3637         &              ,mpi_sum,mpi_comm_opa,ierror) 
    35993638    ptab(:) = zwork(:) 
    36003639 
    … …  
    36403679 
    36413680    CALL mpi_allreduce(ptab, zwork, 1,mpi_double_precision   & 
    3642          &              ,mpi_sum,mpi_comm_world,ierror) 
     3681         &              ,mpi_sum,mpi_comm_opa,ierror) 
    36433682    ptab = zwork 
    36443683 
    … …  
    36873726    zain(2,:)=ki+10000.*kj 
    36883727 
    3689     CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MINLOC,MPI_COMM_WORLD,ierror) 
     3728    CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MINLOC,MPI_COMM_OPA,ierror) 
    36903729 
    36913730    pmin=zaout(1,1) 
    … …  
    37383777    zain(2,:)=ki+10000.*kj+100000000.*kk 
    37393778 
    3740     CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MINLOC,MPI_COMM_WORLD,ierror) 
     3779    CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MINLOC,MPI_COMM_OPA,ierror) 
    37413780 
    37423781    pmin=zaout(1,1) 
    … …  
    37893828    zain(2,:)=ki+10000.*kj 
    37903829 
    3791     CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MAXLOC,MPI_COMM_WORLD,ierror) 
     3830    CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MAXLOC,MPI_COMM_OPA,ierror) 
    37923831 
    37933832    pmax=zaout(1,1) 
    … …  
    38393878    zain(2,:)=ki+10000.*kj+100000000.*kk 
    38403879 
    3841     CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MAXLOC,MPI_COMM_WORLD,ierror) 
     3880    CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MAXLOC,MPI_COMM_OPA,ierror) 
    38423881 
    38433882    pmax=zaout(1,1) 
    … …  
    38673906    INTEGER :: ierror 
    38683907 
    3869     CALL mpi_barrier(mpi_comm_world,ierror) 
     3908    CALL mpi_barrier(mpi_comm_opa,ierror) 
    38703909 
    38713910#endif 
    … …  
    42014240    ! create the world group 
    42024241    ! 
    4203     CALL MPI_COMM_GROUP(mpi_comm_world,ngrp_world,ierr) 
     4242    CALL MPI_COMM_GROUP(mpi_comm_opa,ngrp_world,ierr) 
    42044243    ! 
    42054244    ! Create the North group from the world group 
    … …  
    42084247    ! Create the North communicator , ie the pool of procs in the north group 
    42094248    ! 
    4210     CALL MPI_COMM_CREATE(mpi_comm_world,ngrp_north,ncomm_north,ierr) 
     4249    CALL MPI_COMM_CREATE(mpi_comm_opa,ngrp_north,ncomm_north,ierr) 
    42114250 
    42124251 
    … …  
    49965035!$AGRIF_END_DO_NOT_TREAT 
    49975036 
    4998       INTEGER                                 :: code,rang 
     5037      INTEGER                                 :: code,rang,ierr 
     5038      LOGICAL                                 :: mpi_was_called 
    49995039  
    50005040      ! La valeur suivante doit etre au moins egale a la taille 
    … …  
    50075047  
    50085048      ! Le point d'entree dans la bibliotheque MPI elle-meme 
    5009       CALL mpi_init(code) 
    5010  
     5049      CALL mpi_initialized(mpi_was_called, code) 
     5050      IF ( code /= MPI_SUCCESS ) THEN 
     5051        CALL ctl_stop( ' lib_mpp: Error in routine mpi_initialized' ) 
     5052        CALL mpi_abort( mpi_comm_world, code, ierr ) 
     5053      ENDIF 
     5054 
     5055      IF ( .NOT. mpi_was_called ) THEN 
     5056         CALL mpi_init(code) 
     5057         CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code) 
     5058         IF ( code /= MPI_SUCCESS ) THEN 
     5059            CALL ctl_stop( ' lib_mpp: Error in routine mpi_comm_dup' ) 
     5060            CALL mpi_abort( mpi_comm_world, code, ierr ) 
     5061         ENDIF 
     5062      ENDIF 
    50115063      ! La definition de la zone tampon pour les futurs envois 
    50125064      ! par MPI_BSEND (on alloue une fois pour toute cette zone 
    … …  
    50345086      ! "data" soit 7 segments, c.-a -d. 1750/8 = 210 Mo 
    50355087      IF (taille_tampon > 210000000) THEN 
    5036          PRINT *,'Attention la valeur BUFFER_LENGTH doit etre <= 210000000' 
     5088         CALL ctl_stop( ' lib_mpp: Attention la valeur BUFFER_LENGTH doit etre <= 210000000' ) 
    50375089         CALL mpi_abort(MPI_COMM_WORLD,2,code) 
    50385090      END IF 
    50395091 
    5040       CALL mpi_comm_rank(MPI_COMM_WORLD,rang,code) 
     5092      CALL mpi_comm_rank(MPI_COMM_OPA,rang,code) 
    50415093      IF (rang == 0 ) PRINT *,'Taille du buffer alloue : ',taille_tampon 
    50425094 
    … …  
    50785130CONTAINS 
    50795131 
    5080    FUNCTION mynode() RESULT (function_value) 
     5132   FUNCTION mynode(localComm) RESULT (function_value) 
     5133      INTEGER, OPTIONAL :: localComm 
    50815134      function_value = 0 
    50825135   END FUNCTION mynode 

  • trunk/NEMO/OPA_SRC/opa.F90

    r531 r532  
    2828   !!        !  00-07  (J-M Molines, M. Imbard)  Open Boundary Conditions  (CLIPPER) 
    2929   !!   9.0  !  02-08  (G. Madec)  F90: Free form and modules 
     30   !!    "   !  04-06  (R. Redler, NEC CCRLE, Germany) add OASIS[3/4] coupled interfaces 
    3031   !!    "   !  04-08  (C. Talandier) New trends organization 
    3132   !!    "   !  05-06  (C. Ethe) Add the 1D configuration possibility 
    … …  
    6869 
    6970   USE step            ! OPA time-stepping                  (stp     routine) 
     71#if defined key_oasis3 
     72   USE cpl_oasis3      ! OASIS3 coupling (to ECHAM5) 
     73#else if defined key_oasis4 
     74   USE cpl_oasis4      ! OASIS4 coupling (to ECHAM5) 
     75#endif 
     76   USE dynspg_oce      ! Control choice of surface pressure gradient schemes 
    7077   USE prtctl          ! Print control                 (prt_ctl_init routine) 
    7178   USE ini1d           ! re-initialization of u-v mask for the 1D configuration 
    … …  
    149156 
    150157      CALL opa_closefile 
     158#if defined key_oasis3 || defined key_oasis4 
     159      call cpl_prism_finalize 
     160#else 
    151161      IF( lk_mpp )   CALL mppstop                          ! Close all files (mpp) 
     162#endif 
    152163 
    153164   END SUBROUTINE opa_model 
    … …  
    163174#if defined key_coupled 
    164175      INTEGER ::   itro, istp0        ! ??? 
     176#endif 
     177#if defined key_oasis3 || defined key_oasis4 
     178      INTEGER :: localComm 
    165179#endif 
    166180      CHARACTER (len=20) ::   namelistname 
    … …  
    197211      READ  ( numnam, namctl ) 
    198212 
     213#ifdef key_oasis3 || defined key_oasis4 
     214      call cpl_prism_init(localComm) 
     215      ! Nodes selection 
     216      narea = mynode(localComm) 
     217#else 
    199218      ! Nodes selection 
    200219      narea = mynode() 
     220#endif 
    201221      narea = narea + 1    ! mynode return the rank of proc (0 --> jpnij -1 ) 
    202222      lwp   = narea == 1 
    … …  
    286306#endif 
    287307 
    288 #if defined key_coupled 
     308#if defined key_coupled && ! defined key_oasis3 && ! defined key_oasis4 
    289309      itro  = nitend - nit000 + 1           ! Coupled 
    290310      istp0 = NINT( rdt ) 
    291311      CALL cpl_init( itro, nexco, istp0 )   ! Signal processing and process id exchange 
     312#endif 
     313 
     314#if defined key_oasis3 || defined key_oasis4 
     315      CALL cpl_prism_define 
    292316#endif 
    293317 
    … …  
    398422         SELECT CASE ( cp_cfg ) 
    399423         CASE ( 'gyre' ) 
    400             CALL ctl_warn( ' The Benchmark is activated ' ) 
     424            CALL ctl_warn( '          The Benchmark is activated ' ) 
    401425         CASE DEFAULT 
    402             CALL ctl_stop( ' The Benchmark is based on the GYRE configuration: key_gyre must be used or set nbench = 0' ) 
     426            CALL ctl_stop( '          The Benchmark is based on the GYRE configuration: key_gyre must & 
     427               &                      be used or set nbench = 0' ) 
    403428         END SELECT 
    404429      ENDIF 
    405430 
    406       SELECT CASE ( nbit_cmp ) 
    407       CASE ( 1 ) 
    408          CALL ctl_warn( ' Bit comparison enabled Single and multiple processor results should bit compare', & 
    409               &         ' WARNING: RESULTS ARE NOT PHYSICAL.' ) 
    410       CASE DEFAULT 
    411          CALL ctl_warn( ' Bit comparison not enabled. Single and multiple processor results will differ.' ) 
    412       END SELECT 
     431      IF( nbit_cmp == 1 )   THEN 
     432         CALL ctl_warn( '          Bit comparison enabled. Single and multiple processor results must bit compare', & 
     433              &         '          WARNING: RESULTS ARE NOT PHYSICAL.' ) 
     434      ENDIF 
    413435 
    414436 
Note: See TracChangeset for help on using the changeset viewer.