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 1528 for trunk/NEMO/OPA_SRC/lib_mpp.F90 – NEMO

Ignore:
Timestamp:
2009-07-23T16:38:47+02:00 (15 years ago)
Author:
rblod
Message:

Suppress rigid-lid option, see ticket #486

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMO/OPA_SRC/lib_mpp.F90

    r1490 r1528  
    3131   !!   mppscatter  : 
    3232   !!   mppgather   : 
    33    !!   mpp_isl     : generic inteface  for mppisl_int , mppisl_a_int , mppisl_real, mppisl_a_real 
    3433   !!   mpp_min     : generic interface for mppmin_int , mppmin_a_int , mppmin_real, mppmin_a_real 
    3534   !!   mpp_max     : generic interface for mppmax_int , mppmax_a_int , mppmax_real, mppmax_a_real 
    … …  
    7170   PUBLIC   mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e 
    7271   PUBLIC   mpprecv, mppsend, mppscatter, mppgather 
    73    PUBLIC   mppobc, mpp_ini_ice, mpp_isl, mpp_ini_znl 
     72   PUBLIC   mppobc, mpp_ini_ice, mpp_ini_znl 
    7473#if defined key_oasis3 || defined key_oasis4 
    7574   PUBLIC   mppsize, mpprank 
    … …  
    8079   !! with scalar arguments instead of array arguments, which causes problems 
    8180   !! for the compilation on AIX system as well as NEC and SGI. Ok on COMPACQ 
    82    INTERFACE mpp_isl 
    83       MODULE PROCEDURE mppisl_a_int, mppisl_int, mppisl_a_real, mppisl_real 
    84    END INTERFACE 
    8581   INTERFACE mpp_min 
    8682      MODULE PROCEDURE mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real 
    … …  
    11201116 
    11211117 
    1122    SUBROUTINE mppisl_a_int( ktab, kdim ) 
    1123       !!---------------------------------------------------------------------- 
    1124       !!                  ***  routine mppisl_a_int  *** 
    1125       !!                    
    1126       !! ** Purpose :   Massively parallel processors 
    1127       !!                Find the  non zero value 
    1128       !! 
    1129       !!---------------------------------------------------------------------- 
    1130       INTEGER, INTENT(in   )                  ::   kdim       ! ??? 
    1131       INTEGER, INTENT(inout), DIMENSION(kdim) ::   ktab       ! ??? 
    1132       !! 
    1133       LOGICAL  :: lcommute 
    1134       INTEGER  :: mpi_isl, ierror   ! temporary integer 
    1135       INTEGER, DIMENSION(kdim) ::   iwork 
    1136       !!---------------------------------------------------------------------- 
    1137       ! 
    1138       lcommute = .TRUE. 
    1139       CALL mpi_op_create( lc_isl, lcommute, mpi_isl, ierror ) 
    1140       CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_isl, mpi_comm_opa, ierror ) 
    1141       ktab(:) = iwork(:) 
    1142       ! 
    1143    END SUBROUTINE mppisl_a_int 
    1144  
    1145  
    1146    SUBROUTINE mppisl_int( ktab ) 
    1147       !!---------------------------------------------------------------------- 
    1148       !!                  ***  routine mppisl_int  *** 
    1149       !!                    
    1150       !! ** Purpose :   Massively parallel processors 
    1151       !!                Find the non zero value 
    1152       !! 
    1153       !!---------------------------------------------------------------------- 
    1154       INTEGER , INTENT(inout) ::   ktab   !  
    1155       !! 
    1156       LOGICAL ::   lcommute 
    1157       INTEGER ::   mpi_isl, ierror, iwork   ! temporary integer 
    1158       !!---------------------------------------------------------------------- 
    1159       ! 
    1160       lcommute = .TRUE. 
    1161       CALL mpi_op_create( lc_isl, lcommute, mpi_isl, ierror ) 
    1162       CALL mpi_allreduce(ktab, iwork, 1, mpi_integer, mpi_isl, mpi_comm_opa, ierror) 
    1163       ktab = iwork 
    1164       ! 
    1165    END SUBROUTINE mppisl_int 
    1166  
    1167  
    11681118   SUBROUTINE mppmax_a_int( ktab, kdim, kcom ) 
    11691119      !!---------------------------------------------------------------------- 
    … …  
    13001250      ! 
    13011251   END SUBROUTINE mppsum_int 
    1302  
    1303  
    1304    SUBROUTINE mppisl_a_real( ptab, kdim ) 
    1305       !!---------------------------------------------------------------------- 
    1306       !!                 ***  routine mppisl_a_real  *** 
    1307       !!          
    1308       !! ** Purpose :   Massively parallel processors 
    1309       !!           Find the non zero island barotropic stream function value 
    1310       !! 
    1311       !!   Modifications: 
    1312       !!        !  93-09 (M. Imbard) 
    1313       !!        !  96-05 (j. Escobar) 
    1314       !!        !  98-05 (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI  
    1315       !!---------------------------------------------------------------------- 
    1316       INTEGER , INTENT( in  )                  ::   kdim      ! ??? 
    1317       REAL(wp), INTENT(inout), DIMENSION(kdim) ::   ptab      ! ??? 
    1318       !! 
    1319       LOGICAL ::   lcommute = .TRUE. 
    1320       INTEGER ::   mpi_isl, ierror 
    1321       REAL(wp), DIMENSION(kdim) ::  zwork 
    1322       !!---------------------------------------------------------------------- 
    1323       ! 
    1324       CALL mpi_op_create( lc_isl, lcommute, mpi_isl, ierror ) 
    1325       CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_isl, mpi_comm_opa, ierror ) 
    1326       ptab(:) = zwork(:) 
    1327       ! 
    1328    END SUBROUTINE mppisl_a_real 
    1329  
    1330  
    1331    SUBROUTINE mppisl_real( ptab ) 
    1332       !!---------------------------------------------------------------------- 
    1333       !!                  ***  routine mppisl_real  *** 
    1334       !!                   
    1335       !! ** Purpose :   Massively parallel processors 
    1336       !!       Find the  non zero island barotropic stream function value 
    1337       !! 
    1338       !!     Modifications: 
    1339       !!        !  93-09 (M. Imbard) 
    1340       !!        !  96-05 (j. Escobar) 
    1341       !!        !  98-05 (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI  
    1342       !!---------------------------------------------------------------------- 
    1343       REAL(wp), INTENT(inout) ::   ptab 
    1344  
    1345       LOGICAL  ::   lcommute = .TRUE. 
    1346       INTEGER  ::   mpi_isl, ierror 
    1347       REAL(wp) ::   zwork 
    1348       !!---------------------------------------------------------------------- 
    1349       ! 
    1350       CALL mpi_op_create( lc_isl, lcommute, mpi_isl, ierror ) 
    1351       CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_isl, mpi_comm_opa, ierror ) 
    1352       ptab = zwork 
    1353       ! 
    1354    END SUBROUTINE mppisl_real 
    1355  
    1356  
    1357    FUNCTION lc_isl( py, px, kdim ) 
    1358       !!---------------------------------------------------------------------- 
    1359       !!---------------------------------------------------------------------- 
    1360       INTEGER                   ::   kdim 
    1361       REAL(wp), DIMENSION(kdim) ::   px, py 
    1362       !! 
    1363       INTEGER :: ji 
    1364       INTEGER :: lc_isl 
    1365       !!---------------------------------------------------------------------- 
    1366       ! 
    1367       DO ji = 1, kdim 
    1368          IF( py(ji) /= 0. )   px(ji) = py(ji) 
    1369       END DO 
    1370       lc_isl=0 
    1371       ! 
    1372    END FUNCTION lc_isl 
    13731252 
    13741253 
    … …  
    23962275      MODULE PROCEDURE mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real 
    23972276   END INTERFACE 
    2398    INTERFACE mpp_isl 
    2399       MODULE PROCEDURE mppisl_a_int, mppisl_int, mppisl_a_real, mppisl_real 
    2400    END INTERFACE 
    24012277   INTERFACE mppobc 
    24022278      MODULE PROCEDURE mppobc_1d, mppobc_2d, mppobc_3d, mppobc_4d 
    … …  
    25322408   END SUBROUTINE mppobc_4d 
    25332409 
    2534    SUBROUTINE mppisl_a_int( karr, kdim ) 
    2535       INTEGER, DIMENSION(:) :: karr 
    2536       INTEGER               :: kdim 
    2537       WRITE(*,*) 'mppisl_a_int: You should not have seen this print! error?', kdim, karr(1) 
    2538    END SUBROUTINE mppisl_a_int 
    2539  
    2540    SUBROUTINE mppisl_int( kint ) 
    2541       INTEGER               :: kint 
    2542       WRITE(*,*) 'mppisl_int: You should not have seen this print! error?', kint 
    2543    END SUBROUTINE mppisl_int 
    2544  
    2545    SUBROUTINE mppisl_a_real( parr, kdim ) 
    2546       REAL   , DIMENSION(:) :: parr 
    2547       INTEGER               :: kdim 
    2548       WRITE(*,*) 'mppisl_a_real: You should not have seen this print! error?', kdim, parr(1) 
    2549    END SUBROUTINE mppisl_a_real 
    2550  
    2551    SUBROUTINE mppisl_real( psca ) 
    2552       REAL                  :: psca 
    2553       WRITE(*,*) 'mppisl_real: You should not have seen this print! error?', psca 
    2554    END SUBROUTINE mppisl_real 
    2555  
    25562410   SUBROUTINE mpp_minloc2d( ptab, pmask, pmin, ki, kj ) 
    25572411      REAL                   :: pmin 
    25582412      REAL , DIMENSION (:,:) :: ptab, pmask 
    25592413      INTEGER :: ki, kj 
    2560       WRITE(*,*) 'mppisl_real: You should not have seen this print! error?', pmin, ki, kj, ptab(1,1), pmask(1,1) 
     2414      WRITE(*,*) 'mpp_minloc2d: You should not have seen this print! error?', pmin, ki, kj, ptab(1,1), pmask(1,1) 
    25612415   END SUBROUTINE mpp_minloc2d 
    25622416 
    … …  
    25652419      REAL , DIMENSION (:,:,:) :: ptab, pmask 
    25662420      INTEGER :: ki, kj, kk 
    2567       WRITE(*,*) 'mppisl_real: You should not have seen this print! error?', pmin, ki, kj, kk, ptab(1,1,1), pmask(1,1,1) 
     2421      WRITE(*,*) 'mpp_minloc3d: You should not have seen this print! error?', pmin, ki, kj, kk, ptab(1,1,1), pmask(1,1,1) 
    25682422   END SUBROUTINE mpp_minloc3d 
    25692423 
    … …  
    25722426      REAL , DIMENSION (:,:) :: ptab, pmask 
    25732427      INTEGER :: ki, kj 
    2574       WRITE(*,*) 'mppisl_real: You should not have seen this print! error?', pmax, ki, kj, ptab(1,1), pmask(1,1) 
     2428      WRITE(*,*) 'mpp_maxloc2d: You should not have seen this print! error?', pmax, ki, kj, ptab(1,1), pmask(1,1) 
    25752429   END SUBROUTINE mpp_maxloc2d 
    25762430 
    … …  
    25792433      REAL , DIMENSION (:,:,:) :: ptab, pmask 
    25802434      INTEGER :: ki, kj, kk 
    2581       WRITE(*,*) 'mppisl_real: You should not have seen this print! error?', pmax, ki, kj, kk, ptab(1,1,1), pmask(1,1,1) 
     2435      WRITE(*,*) 'mpp_maxloc3d: You should not have seen this print! error?', pmax, ki, kj, kk, ptab(1,1,1), pmask(1,1,1) 
    25822436   END SUBROUTINE mpp_maxloc3d 
    25832437 
Note: See TracChangeset for help on using the changeset viewer.