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 16 – NEMO

Changeset 16


Ignore:
Timestamp:
2004-02-17T09:06:15+01:00 (20 years ago)
Author:
opalod
Message:

CT : UPDATE001 : First major NEMO update

Location:
trunk/NEMO/OPA_SRC
Files:
26 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMO/OPA_SRC/DTA/dtasal.F90

    r3 r16  
    2323    
    2424   !! * Shared module variables 
    25    LOGICAL , PUBLIC, PARAMETER ::   lk_dtasal = .TRUE.    ! salinity data flag 
    26    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   & 
    27       s_dta       ! salinity data at given time-step 
     25   LOGICAL , PUBLIC, PARAMETER ::   lk_dtasal = .TRUE.    !: salinity data flag 
     26   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !: 
     27      s_dta       !: salinity data at given time-step 
    2828 
    2929   !! * Module variables 
    … …  
    8181      INTEGER ::   ji, jj, jk, jl    ! dummy loop indicies 
    8282      INTEGER ::   & 
    83          imois, iman, ik, i15,  &  ! temporary integers 
    84          ipi, ipj, ipk, itime      !    "          " 
     83         imois, iman, ik, i15,       &  ! temporary integers 
     84         ipi, ipj, ipk, itime,       &  !    "          " 
     85         il0, il1, ii0, ii1, ij0, ij1   !    "          " 
    8586      INTEGER, DIMENSION(jpmois) ::   istep 
    8687      REAL(wp) ::   & 
    … …  
    186187            !                                        !  ORCA_R2 configuration 
    187188            !                                        ! ======================= 
    188           
    189             DO jj = mj0(101), mj1(109)                      ! Reduced salinity in the Alboran Sea 
    190                DO ji = mi0(141), mi1(155) 
     189            ij0 = 101   ;   ij1 = 109 
     190            ii0 = 141   ;   ii1 = 155    
     191            DO jj = mj0(ij0), mj1(ij1)                      ! Reduced salinity in the Alboran Sea 
     192               DO ji = mi0(ii0), mi1(ii1) 
    191193                  DO jk = 13, 13 
    192194                     saldta(ji,jj,jk,:) = saldta(ji,jj,jk,:) - 0.15 
    … …  
    205207            IF( n_cla == 1 ) THEN  
    206208               !                                         ! New salinity profile at Gibraltar 
    207                saldta( mi0(139):mi1(139) , mj0(101):mj1(101) , : , : ) =   & 
    208                   &                                    saldta( mi0(138):mi1(138) , mj0(101):mj1(101) , : , : ) 
    209                saldta( mi0(139):mi1(139) , mj0(102):mj1(102) , : , : ) =   & 
    210                   &                                    saldta( mi0(138):mi1(138) , mj0(102):mj1(102) , : , : ) 
    211                DO jl = mi0(138), mi1(138)                ! New temperature profile at Gibraltar 
    212                   DO jj = mj0(101), mj1(102) 
    213                      DO ji = mi0(139), mi1(139) 
     209               il0 = 138   ;   il1 = 138    
     210               ij0 = 101   ;   ij1 = 101 
     211               ii0 = 139   ;   ii1 = 139    
     212               saldta( mi0(ii0):mi1(ii1), mj0(ij0):mj1(ij1) , : , : ) =   & 
     213                  &                                    saldta( mi0(il0):mi1(il1) , mj0(ij0):mj1(ij1) , : , : ) 
     214               ij0 = 101   ;   ij1 = 101 
     215               saldta( mi0(ii0):mi1(ii1), mj0(ij0):mj1(ij1) , : , : ) =   & 
     216                  &                                    saldta( mi0(il0):mi1(il1) , mj0(ij0):mj1(ij1) , : , : ) 
     217               il0 = 138   ;   il1 = 138    
     218               ij0 = 101   ;   ij1 = 102 
     219               ii0 = 139   ;   ii1 = 139    
     220               DO jl = mi0(ii0), mi1(ii1)                ! New salinity profile at Gibraltar 
     221                  DO jj = mj0(ij0), mj1(ij1) 
     222                     DO ji = mi0(ii0), mi1(ii1) 
    214223                        saldta(ji,jj,:,:) = saldta(jl,jj,:,:) 
    215224                     END DO 
    … …  
    217226               END DO 
    218227 
    219                DO jl = mi0(164), mi1(164)                ! New salinity profile at Bab el Mandeb 
    220                   DO jj = mj0(88), mj1(88) 
    221                      DO ji = mi0(161), mi1(163) 
     228               il0 = 164   ;   il1 = 164    
     229               ij0 =  88   ;   ij1 =  88 
     230               ii0 = 161   ;   ii1 = 163    
     231               DO jl = mi0(ii0), mi1(ii1)                ! New salinity profile at Bab el Mandeb 
     232                  DO jj = mj0(ij0), mj1(ij1) 
     233                     DO ji = mi0(ii0), mi1(ii1) 
    222234                        saldta(ji,jj,:,:) = saldta(jl,jj,:,:) 
    223235                     END DO 
    224236                  END DO 
    225                   DO jj = mj0(87), mj1(87) 
    226                      DO ji = mi0(161), mi1(163) 
     237                  ij0 =  87   ;   ij1 =  87 
     238                  DO jj = mj0(ij0), mj1(ij1) 
     239                     DO ji = mi0(ii0), mi1(ii1) 
    227240                        saldta(ji,jj,:,:) = saldta(jl,jj,:,:) 
    228241                     END DO 
    … …  
    280293   !!   Default option:                                    NO salinity data 
    281294   !!---------------------------------------------------------------------- 
    282    LOGICAL, PUBLIC, PARAMETER ::   lk_dtasal = .FALSE.   ! salinity data flag 
     295   LOGICAL , PUBLIC, PARAMETER ::   lk_dtasal = .FALSE.   !: salinity data flag 
    283296CONTAINS 
    284297   SUBROUTINE dta_sal( kt )        ! Empty routine 
    285       WRITE(*,*) kt 
     298      WRITE(*,*) 'dta_sal: You should not have seen this print! error?', kt 
    286299   END SUBROUTINE dta_sal 
    287300#endif 

  • trunk/NEMO/OPA_SRC/DTA/dtasst.F90

    r3 r16  
    2626   !! * Shared module variables 
    2727#if defined key_dtasst 
    28    LOGICAL , PUBLIC, PARAMETER ::   lk_dtasst = .TRUE.   ! sst data flag 
     28   LOGICAL , PUBLIC, PARAMETER ::   lk_dtasst = .TRUE.   !: sst data flag 
    2929#else 
    30    LOGICAL , PUBLIC, PARAMETER ::   lk_dtasst = .TRUE.   ! sst data flag 
     30   LOGICAL , PUBLIC, PARAMETER ::   lk_dtasst = .FALSE.  !: sst data flag 
    3131#endif 
    32    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   & 
    33       sst             ! surface temperature 
    34    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2) ::   & 
    35       rclice          ! climatological ice index (0/1) (2 months) 
     32   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  !: 
     33      sst             !: surface temperature 
     34   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2) ::   &  !: 
     35      rclice          !: climatological ice index (0/1) (2 months) 
    3636   !!---------------------------------------------------------------------- 
    3737   !!   OPA 9.0 , IPSL-LODYC  (2003) 

  • trunk/NEMO/OPA_SRC/DTA/dtatem.F90

    r3 r16  
    2323 
    2424   !! * Shared module variables 
    25    LOGICAL , PUBLIC, PARAMETER ::   lk_dtatem = .TRUE.   ! temperature data flag 
    26    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   & 
    27       t_dta             ! temperature data at given time-step 
     25   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatem = .TRUE.   !: temperature data flag 
     26   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !: 
     27      t_dta             !: temperature data at given time-step 
    2828 
    2929   !! * Module variables 
    … …  
    9191      INTEGER ::   & 
    9292         imois, iman, itime, ik ,    &  ! temporary integers 
    93          i15, ipi, ipj, ipk             !    "          " 
     93         i15, ipi, ipj, ipk,         &  !    "          " 
     94         il0, il1, ii0, ii1, ij0, ij1   !    "          " 
    9495 
    9596      INTEGER, DIMENSION(jpmois) ::   istep 
    … …  
    192193            !                                        ! =======================  
    193194 
    194             DO jj = mj0(101), mj1(109)                   ! Reduced temperature at Alboran Sea 
    195                DO ji = mi0(141), mi1(155) 
     195            ij0 = 101   ;   ij1 = 109 
     196            ii0 = 141   ;   ii1 = 155 
     197            DO jj = mj0(ij0), mj1(ij1)                      ! Reduced temperature in the Alboran Sea 
     198               DO ji = mi0(ii0), mi1(ii1) 
    196199                  temdta(ji,jj, 13:13 ,:) = temdta(ji,jj, 13:13 ,:) - 0.20 
    197200                  temdta(ji,jj, 14:15 ,:) = temdta(ji,jj, 14:15 ,:) - 0.35 
    … …  
    202205            IF( n_cla == 0 ) THEN  
    203206               !                                         ! Reduced temperature at Red Sea 
    204                temdta( mi0(148):mi1(160) , mj0(87):mj1(96) ,  4:10 , : ) = 7.0  
    205                temdta( mi0(148):mi1(160) , mj0(87):mj1(96) , 11:13 , : ) = 6.5  
    206                temdta( mi0(148):mi1(160) , mj0(87):mj1(96) , 14:20 , : ) = 6.0 
     207               ij0 =  87   ;   ij1 =  96 
     208               ii0 = 148   ;   ii1 = 160 
     209               temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 , : ) = 7.0  
     210               temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 , : ) = 6.5  
     211               temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 , : ) = 6.0 
    207212            ELSE 
    208                DO jl = mi0(138), mi1(138)                ! New temperature profile at Gibraltar 
    209                   DO jj = mj0(101), mj1(102) 
    210                      DO ji = mi0(139), mi1(139) 
     213               il0 = 138   ;   il1 = 138 
     214               ij0 = 101   ;   ij1 = 102 
     215               ii0 = 139   ;   ii1 = 139 
     216               DO jl = mi0(ii0), mi1(ii1)                ! New temperature profile at Gibraltar 
     217                  DO jj = mj0(ij0), mj1(ij1) 
     218                     DO ji = mi0(ii0), mi1(ii1) 
    211219                        temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 
    212220                     END DO 
    213221                  END DO 
    214222               END DO 
    215                DO jl = mi0(164), mi1(164)                ! New temperature profile at Bab el Mandeb 
    216                   DO jj = mj0(88), mj1(88) 
    217                      DO ji = mi0(161), mi1(163) 
     223               il0 = 164   ;   il1 = 164 
     224               ij0 =  88   ;   ij1 =  88 
     225               ii0 = 161   ;   ii1 = 163 
     226               DO jl = mi0(ii0), mi1(ii1)                ! New temperature profile at Bab el Mandeb 
     227                  DO jj = mj0(ij0), mj1(ij1) 
     228                     DO ji = mi0(ii0), mi1(ii1) 
    218229                        temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 
    219230                     END DO 
    220231                  END DO 
    221                   DO jj = mj0(87), mj1(87) 
    222                      DO ji = mi0(161), mi1(163) 
     232                  ij0 =  87   ;   ij1 =  87 
     233                  DO jj = mj0(ij0), mj1(ij1) 
     234                     DO ji = mi0(ii0), mi1(ii1) 
    223235                        temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 
    224236                     END DO 
    … …  
    274286   !!   Default case                           NO 3D temperature data field 
    275287   !!---------------------------------------------------------------------- 
    276    LOGICAL , PUBLIC, PARAMETER ::   lk_dtatem = .FALSE.   ! temperature data flag 
     288   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatem = .FALSE.   !: temperature data flag 
    277289CONTAINS 
    278290   SUBROUTINE dta_tem( kt )        ! Empty routine 
    279       WRITE(*,*) kt 
     291      WRITE(*,*) 'dta_tem: You should not have seen this print! error?', kt 
    280292   END SUBROUTINE dta_tem 
    281293#endif 

  • trunk/NEMO/OPA_SRC/FLO/flo4rk.F90

    r3 r16  
    1515   USE oce             ! ocean dynamics and tracers 
    1616   USE dom_oce         ! ocean space and time domain 
     17   USE in_out_manager  ! I/O manager 
    1718 
    1819   IMPLICIT NONE 
    … …  
    2425   !! * Module variables 
    2526   REAL(wp), DIMENSION (4) ::   &   ! RK4 and Lagrange interpolation 
    26       tcoef1 = /  1.0  ,  0.5  ,  0.5  ,  0.0  / ,  &  ! coeffients  for  
    27       tcoef2 = /  0.0  ,  0.5  ,  0.5  ,  1.0  / ,  &  ! lagrangian interp. 
    28       scoef2 = /  1.0  ,  2.0  ,  2.0  ,  1.0  / ,  &  ! RK4 coefficients 
    29       rcoef  = /-1./6. , 1./2. ,-1./2. , 1./6. /       ! ??? 
     27      tcoef1 = (/  1.0  ,  0.5  ,  0.5  ,  0.0  /) ,  &  ! coeffients  for  
     28      tcoef2 = (/  0.0  ,  0.5  ,  0.5  ,  1.0  /) ,  &  ! lagrangian interp. 
     29      scoef2 = (/  1.0  ,  2.0  ,  2.0  ,  1.0  /) ,  &  ! RK4 coefficients 
     30      rcoef  = (/-1./6. , 1./2. ,-1./2. , 1./6. /)       ! ??? 
    3031   REAL(wp), DIMENSION (3) ::   & 
    31       scoef1 = / .5, .5, 1. /       ! compute position with interpolated 
     32      scoef1 = (/ .5, .5, 1. /)       ! compute position with interpolated 
    3233   !!---------------------------------------------------------------------- 
    3334   !!   OPA 9.0 , LODYC-IPSL  (2003) 

  • trunk/NEMO/OPA_SRC/FLO/flo_oce.F90

    r3 r16  
    1111   !!  OPA 9.0 , LODYC-IPSL (2003) 
    1212   !!---------------------------------------------------------------------- 
    13 #if defined key_floats 
     13#if   defined key_floats   ||   defined key_esopa 
    1414   !!---------------------------------------------------------------------- 
    1515   !!   'key_floats'                                        drifting floats 
    … …  
    2020   IMPLICIT NONE 
    2121 
    22    LOGICAL, PUBLIC, PARAMETER ::   lk_floats = .TRUE.    ! float flag 
     22   LOGICAL, PUBLIC, PARAMETER ::   lk_floats = .TRUE.    !: float flag 
    2323 
    2424   !! float parameters 
    2525   !! ---------------- 
    2626   INTEGER, PARAMETER ::   & 
    27       jpnfl      = 23 ,          &  ! total number of floats during the run 
    28       jpnnewfl   =  0 ,          &  ! number of floats added in a new run 
    29       jpnrstarfl = jpnfl-jpnnewfl   ! number of floats for the restart 
     27      jpnfl     = 23 ,            &  ! total number of floats during the run 
     28      jpnnewflo =  0 ,            &  ! number of floats added in a new run 
     29      jpnrstflo = jpnfl-jpnnewflo    ! number of floats for the restart 
    3030 
    3131   !! float variables 
    … …  
    6161   !!   Default option :                                 NO drifting floats 
    6262   !!---------------------------------------------------------------------- 
    63    LOGICAL, PUBLIC, PARAMETER ::   lk_floats = .FALSE.   ! float flag 
     63   LOGICAL, PUBLIC, PARAMETER ::   lk_floats = .FALSE.   !: float flag 
    6464#endif 
    6565 

  • trunk/NEMO/OPA_SRC/FLO/floats.F90

    r3 r16  
    6767      ENDIF 
    6868 
    69 # if defined key_mpp 
    70       CALL mppsync 
    71 # endif 
     69      IF( lk_mpp )   CALL mppsync   ! synchronization of all the processor 
     70 
    7271 
    7372      ! Writing and restart       
    … …  
    9897 
    9998      !! * Local declarations 
    100       NAMELIST/namflo/ ln_rstarfl, nwritefl, nstockfl  
     99      NAMELIST/namflo/ ln_rstflo, nwritefl, nstockfl  
    101100      !!--------------------------------------------------------------------- 
    102101      ! Namelist namflo : floats 
    103102       
    104103      ! default values 
    105       ln_rstarfl  = .FALSE. 
     104      ln_rstflo  = .FALSE. 
    106105      nwritefl  = 150 
    107106      nstockfl  = 450 
    … …  
    114113         WRITE(numout,*) ' ' 
    115114         WRITE(numout,*) '         Namelist floats :' 
    116          WRITE(numout,*) '            restart                          ln_rstarfl = ', ln_rstarfl 
    117          WRITE(numout,*) '            frequency of float output file   nwritefl   = ', nwritefl 
    118          WRITE(numout,*) '            frequency of float restart file  nstockfl   = ', nstockfl 
     115         WRITE(numout,*) '            restart                          ln_rstflo = ', ln_rstflo 
     116         WRITE(numout,*) '            frequency of float output file   nwritefl  = ', nwritefl 
     117         WRITE(numout,*) '            frequency of float restart file  nstockfl  = ', nstockfl 
    119118         WRITE(numout,*) ' ' 
    120119      ENDIF 
    … …  
    128127CONTAINS 
    129128   SUBROUTINE flo_stp( kt )          ! Empty routine 
    130       WRITE(*,*) kt 
     129      WRITE(*,*) 'flo_stp: You should not have seen this print! error?', kt 
    131130   END SUBROUTINE flo_stp 
    132131#endif 

  • trunk/NEMO/OPA_SRC/FLO/floblk.F90

    r3 r16  
    1717   USE dom_oce         ! ocean space and time domain 
    1818   USE phycst          ! physical constants 
     19   USE in_out_manager  ! I/O manager 
    1920   USE lib_mpp         ! distribued memory computing library 
    2021 
    … …  
    105106      iloop = 0 
    106107222   DO jfl = 1, jpnfl 
    107 # if defined key_mpp 
     108# if   defined key_mpp_mpi   ||   defined key_mpp_shmem 
    108109         IF( (iil(jfl) >= (mig(nldi)-jpizoom+1)) .AND. (iil(jfl) <= (mig(nlei)-jpizoom+1)) .AND.   & 
    109110             (ijl(jfl) >= (mjg(nldj)-jpjzoom+1)) .AND. (ijl(jfl) <= (mjg(nlej)-jpjzoom+1)) ) THEN 
    … …  
    320321            ! reinitialisation of the age of FLOAT 
    321322            zagefl(jfl) = zagenewfl(jfl) 
    322 # if defined key_mpp 
     323# if   defined key_mpp_mpi   ||   defined key_mpp_shmem 
    323324         ELSE 
    324325            ! we put zgifl, zgjfl, zgkfl, zagefl 
    … …  
    334335       
    335336      ! synchronisation 
    336       ! sum of this arrays 
    337              
    338 # if defined key_mpp 
    339       CALL mpp_sum( zgifl , jpnfl ) 
    340       CALL mpp_sum( zgjfl , jpnfl ) 
    341       CALL mpp_sum( zgkfl , jpnfl ) 
    342       CALL mpp_sum( zagefl, jpnfl ) 
    343       CALL mpp_sum( iil   , jpnfl ) 
    344       CALL mpp_sum( ijl   , jpnfl ) 
    345 # endif 
     337      IF( lk_mpp )   CALL mpp_sum( zgifl , jpnfl )   ! sums over the global domain 
     338      IF( lk_mpp )   CALL mpp_sum( zgjfl , jpnfl ) 
     339      IF( lk_mpp )   CALL mpp_sum( zgkfl , jpnfl ) 
     340      IF( lk_mpp )   CALL mpp_sum( zagefl, jpnfl ) 
     341      IF( lk_mpp )   CALL mpp_sum( iil   , jpnfl ) 
     342      IF( lk_mpp )   CALL mpp_sum( ijl   , jpnfl ) 
    346343       
    347344      ! in the case of open boundaries we need to test if the floats don't 

  • trunk/NEMO/OPA_SRC/FLO/flodom.F90

    r3 r16  
    1313   !!---------------------------------------------------------------------- 
    1414   !! * Modules used 
    15    USE flo_oce         ! ocean drifting floats 
    1615   USE oce             ! ocean dynamics and tracers 
    1716   USE dom_oce         ! ocean space and time domain 
     17   USE flo_oce         ! ocean drifting floats 
     18!  USE floats 
     19   USE in_out_manager  ! I/O manager 
    1820   USE lib_mpp         ! distribued memory computing library 
    1921 
    … …  
    4345      !!----------------------------------------------------------------------       
    4446      !! * Local declarations 
    45       LOGICAL   :: llinmesh 
     47      LOGICAL  :: llinmesh 
    4648      CHARACTER (len=21) ::  clname 
    47       INTEGER   :: ji, jj, jk               ! DO loop index on 3 directions 
    48       INTEGER   :: jfl, jfl1                ! number of floats    
    49       INTEGER   :: inum = 11                ! logical unit for file read 
    50       INTEGER , DIMENSION ( jpnfl    )  ::   & 
     49      INTEGER  :: ji, jj, jk               ! DO loop index on 3 directions 
     50      INTEGER  :: jfl, jfl1                ! number of floats    
     51      INTEGER  :: inum = 11                ! logical unit for file read 
     52      INTEGER, DIMENSION ( jpnfl    )  ::   & 
    5153         iimfl, ijmfl, ikmfl,    &          ! index mesh of floats 
    5254         idomfl,  ivtest, ihtest 
    53       REAL(wp)  :: zdxab,zdyad 
    54       REAL(wp) , DIMENSION ( jpnnewfl )  :: zgifl, zgjfl,  zgkfl 
     55      REAL(wp) :: zdxab, zdyad 
     56      REAL(wp), DIMENSION ( jpnnewflo+1 )  :: zgifl, zgjfl,  zgkfl 
    5557      !!--------------------------------------------------------------------- 
    5658       
    … …  
    6163      IF(lwp) WRITE(numout,*) '           jpnfl = ',jpnfl 
    6264       
    63       IF(ln_rstarfl) THEN 
     65      IF(ln_rstflo) THEN 
    6466         IF(lwp) WRITE(numout,*) '        float restart file read' 
    6567          
    … …  
    7072 
    7173         ! read of the restart file 
    72          READ(inum) ( tpifl  (jfl), jfl=1, jpnrstarfl),   &  
    73                         ( tpjfl  (jfl), jfl=1, jpnrstarfl),   & 
    74                         ( tpkfl  (jfl), jfl=1, jpnrstarfl),   & 
    75                         ( nisobfl(jfl), jfl=1, jpnrstarfl),   & 
    76                         ( ngrpfl (jfl), jfl=1, jpnrstarfl)     
     74         READ(inum) ( tpifl  (jfl), jfl=1, jpnrstflo),   &  
     75                        ( tpjfl  (jfl), jfl=1, jpnrstflo),   & 
     76                        ( tpkfl  (jfl), jfl=1, jpnrstflo),   & 
     77                        ( nisobfl(jfl), jfl=1, jpnrstflo),   & 
     78                        ( ngrpfl (jfl), jfl=1, jpnrstflo)     
    7779         CLOSE(inum) 
    7880 
    7981         ! if we want a  surface drift  ( like PROVOR floats ) 
    8082         IF( ln_argo ) THEN 
    81             DO jfl = 1, jpnrstarfl 
     83            DO jfl = 1, jpnrstflo 
    8284               nisobfl(jfl) = 0 
    8385            END DO 
    … …  
    8789          
    8890         ! It is possible to add new floats.           
    89          IF(lwp) WRITE(numout,*)' flo_dom:jpnfl jpnrstarfl ',jpnfl,jpnrstarfl 
    90          IF( jpnfl > jpnrstarfl ) THEN 
     91         IF(lwp) WRITE(numout,*)' flo_dom:jpnfl jpnrstflo ',jpnfl,jpnrstflo 
     92         IF( jpnfl > jpnrstflo ) THEN 
    9193            ! open the init file  
    9294            clname='init_float' 
    9395            OPEN(inum,FILE=clname,FORM='FORMATTED') 
    94             DO jfl = jpnrstarfl+1, jpnfl 
     96            DO jfl = jpnrstflo+1, jpnfl 
    9597               READ(inum,*) flxx(jfl),flyy(jfl),flzz(jfl), nisobfl(jfl),ngrpfl(jfl),jfl1 
    9698            END DO 
    … …  
    99101             
    100102            ! Test to find the grid point coordonate with the geographical position             
    101             DO jfl = jpnrstarfl+1, jpnfl 
     103            DO jfl = jpnrstflo+1, jpnfl 
    102104               ihtest(jfl) = 0 
    103105               ivtest(jfl) = 0 
    104106               ikmfl(jfl) = 0 
    105 # if defined key_mpp 
     107# if   defined key_mpp_mpi   ||   defined key_mpp_shmem 
    106108               DO ji = MAX(nldi,2), nlei 
    107109                  DO jj = MAX(nldj,2), nlej 
    … …  
    140142             
    141143            ! A zero in the sum of the arrays "ihtest" and "ivtest"              
    142 # if defined key_mpp 
    143             CALL mpp_sum(ihtest,jpnfl,iwork) 
    144             CALL mpp_sum(ivtest,jpnfl,iwork) 
     144# if   defined key_mpp_mpi   ||   defined key_mpp_shmem 
     145            CALL mpp_sum(ihtest,jpnfl) 
     146            CALL mpp_sum(ivtest,jpnfl) 
    145147# endif  
    146             DO jfl = jpnrstarfl+1, jpnfl 
     148            DO jfl = jpnrstflo+1, jpnfl 
    147149               IF( (ihtest(jfl) > 1 ) .OR. ( ivtest(jfl) > 1) ) THEN 
    148150                  IF(lwp) WRITE(numout,*) 'THE FLOAT',jfl,' IS NOT IN ONLY ONE MESH' 
    … …  
    156158             
    157159            ! We compute the distance between the float and the face of the mesh             
    158             DO jfl = jpnrstarfl+1, jpnfl                
     160            DO jfl = jpnrstflo+1, jpnfl                
    159161               ! Made only if the float is in the domain of the processor               
    160162               IF( (iimfl(jfl) >= 0) .AND. (ijmfl(jfl) >= 0) ) THEN 
    … …  
    182184                  ! Translation of this distances (in meter) in indexes 
    183185                   
    184                   zgifl(jfl-jpnrstarfl)= (iimfl(jfl)-0.5) + zdxab/e1u(iimfl(jfl)-1,ijmfl(jfl)) + (mig(1)-jpizoom) 
    185                   zgjfl(jfl-jpnrstarfl)= (ijmfl(jfl)-0.5) + zdyad/e2v(iimfl(jfl),ijmfl(jfl)-1) + (mjg(1)-jpjzoom) 
    186                   zgkfl(jfl-jpnrstarfl) = (( fsdepw(ji,jj,ikmfl(jfl)+1) - flzz(jfl) )* ikmfl(jfl))  & 
     186                  zgifl(jfl-jpnrstflo)= (iimfl(jfl)-0.5) + zdxab/e1u(iimfl(jfl)-1,ijmfl(jfl)) + (mig(1)-jpizoom) 
     187                  zgjfl(jfl-jpnrstflo)= (ijmfl(jfl)-0.5) + zdyad/e2v(iimfl(jfl),ijmfl(jfl)-1) + (mjg(1)-jpjzoom) 
     188                  zgkfl(jfl-jpnrstflo) = (( fsdepw(ji,jj,ikmfl(jfl)+1) - flzz(jfl) )* ikmfl(jfl))  & 
    187189                                        / (  fsdepw(ji,jj,ikmfl(jfl)+1) - fsdepw(ji,jj,ikmfl(jfl) ) )   & 
    188190                                        + (( flzz(jfl)-fsdepw(ji,jj,ikmfl(jfl)) ) *(ikmfl(jfl)+1))   & 
    189191                                        / (  fsdepw(ji,jj,ikmfl(jfl)+1) - fsdepw(ji,jj,ikmfl(jfl)) )  
    190192               ELSE 
    191                   zgifl(jfl-jpnrstarfl) = 0. 
    192                   zgjfl(jfl-jpnrstarfl) = 0. 
    193                   zgkfl(jfl-jpnrstarfl) = 0. 
     193                  zgifl(jfl-jpnrstflo) = 0. 
     194                  zgjfl(jfl-jpnrstflo) = 0. 
     195                  zgkfl(jfl-jpnrstflo) = 0. 
    194196               ENDIF 
    195197            END DO 
    196198             
    197199            ! The sum of all the arrays zgifl, zgjfl, zgkfl give 3 arrays with the positions of all the floats. 
    198 # if defined key_mpp 
    199  
    200             CALL mpp_sum( zgjfl, jpnnewfl ) 
    201             CALL mpp_sum( zgkfl, jpnnewfl ) 
    202             IF(lwp) WRITE(numout,*) (zgifl(jfl),jfl=1,jpnnewfl) 
    203             IF(lwp) WRITE(numout,*) (zgjfl(jfl),jfl=1,jpnnewfl) 
    204             IF(lwp) WRITE(numout,*) (zgkfl(jfl),jfl=1,jpnnewfl)  
    205 # endif 
     200            IF( lk_mpp )   THEN 
     201               CALL mpp_sum( zgjfl, jpnnewflo )   ! sums over the global domain 
     202               CALL mpp_sum( zgkfl, jpnnewflo ) 
     203               IF(lwp) WRITE(numout,*) (zgifl(jfl),jfl=1,jpnnewflo) 
     204               IF(lwp) WRITE(numout,*) (zgjfl(jfl),jfl=1,jpnnewflo) 
     205               IF(lwp) WRITE(numout,*) (zgkfl(jfl),jfl=1,jpnnewflo)  
     206            ENDIF 
    206207            
    207             DO jfl = jpnrstarfl+1, jpnfl 
    208                tpifl(jfl) = zgifl(jfl-jpnrstarfl) 
    209                tpjfl(jfl) = zgjfl(jfl-jpnrstarfl) 
    210                tpkfl(jfl) = zgkfl(jfl-jpnrstarfl) 
     208            DO jfl = jpnrstflo+1, jpnfl 
     209               tpifl(jfl) = zgifl(jfl-jpnrstflo) 
     210               tpjfl(jfl) = zgjfl(jfl-jpnrstflo) 
     211               tpkfl(jfl) = zgkfl(jfl-jpnrstflo) 
    211212            END DO 
    212213         ENDIF 
    … …  
    234235            ivtest(jfl) = 0 
    235236            ikmfl(jfl) = 0 
    236 # if defined key_mpp 
     237# if   defined key_mpp_mpi   ||   defined key_mpp_shmem 
    237238            DO ji = MAX(nldi,2), nlei 
    238239               DO jj = MAX(nldj,2), nlej 
    … …  
    271272          
    272273         ! A zero in the sum of the arrays "ihtest" and "ivtest"           
    273 # if defined key_mpp 
    274          CALL mpp_sum(ihtest,jpnfl,iwork) 
    275          CALL mpp_sum(ivtest,jpnfl,iwork) 
    276 # endif 
     274         IF( lk_mpp )   CALL mpp_sum(ihtest,jpnfl)   ! sums over the global domain 
     275         IF( lk_mpp )   CALL mpp_sum(ivtest,jpnfl) 
    277276 
    278277         DO jfl = 1, jpnfl 
    … …  
    327326          
    328327         ! The sum of all the arrays tpifl, tpjfl, tpkfl give 3 arrays with the positions of all the floats.  
    329 # if defined key_mpp 
    330          CALL mpp_sum( tpifl , jpnfl ) 
    331          CALL mpp_sum( tpjfl , jpnfl ) 
    332          CALL mpp_sum( tpkfl , jpnfl ) 
    333          CALL mpp_sum( idomfl, jpnfl ) 
    334 # endif 
     328         IF( lk_mpp )   CALL mpp_sum( tpifl , jpnfl )   ! sums over the global domain 
     329         IF( lk_mpp )   CALL mpp_sum( tpjfl , jpnfl ) 
     330         IF( lk_mpp )   CALL mpp_sum( tpkfl , jpnfl ) 
     331         IF( lk_mpp )   CALL mpp_sum( idomfl, jpnfl ) 
    335332      ENDIF 
    336333             
    337334      ! Print the initial positions of the floats 
    338       IF( .NOT. ln_rstarfl ) THEN  
     335      IF( .NOT. ln_rstflo ) THEN  
    339336         ! WARNING : initial position not in the sea          
    340337         DO jfl = 1, jpnfl 

  • trunk/NEMO/OPA_SRC/FLO/flowri.F90

    r3 r16  
    1515   USE dom_oce         ! ocean space and time domain 
    1616   USE lib_mpp         ! distribued memory computing library 
     17   USE daymod 
    1718   USE in_out_manager  ! I/O manager 
    1819 
    … …  
    5253 
    5354      !! * Local declarations 
     55      CHARACTER (len=21) ::  clname 
    5456      INTEGER ::   inum = 11       ! temporary logical unit for restart file 
    5557      INTEGER  ::   & 
    … …  
    6264      REAL(wp) :: zafl,zbfl,zcfl,zdtj 
    6365      REAL(wp) :: zxxu, zxxu_01,zxxu_10, zxxu_11 
    64       REAL(wp) , DIMENSION ( jpk  , jpnfl) :: ztemp, zsal 
    65  
    66       CHARACTER (len=21) ::  clname 
     66      REAL(wp), DIMENSION (jpk,jpnfl) :: ztemp, zsal 
    6767      !!--------------------------------------------------------------------- 
    6868       
    … …  
    8686            IF(lwp) WRITE(numflo)cexper,no,irecflo,jpnfl,nwritefl 
    8787         ENDIF 
    88          zdtj = rdt/86400.       
     88         zdtj = rdt / 86400.      !!bug   use of 86400 instead of the phycst parameter 
    8989 
    9090         ! translation of index position in geographical position 
    9191 
    92          DO jfl = 1, jpnfl 
    93             iafl  = INT (tpifl(jfl)) 
    94             ibfl  = INT (tpjfl(jfl)) 
    95             icfl  = INT (tpkfl(jfl)) 
    96             iafln = NINT(tpifl(jfl)) 
    97             ibfln = NINT(tpjfl(jfl)) 
    98             ia1fl = iafl+1 
    99             ib1fl = ibfl+1 
    100             ic1fl = icfl+1 
    101             zafl  = tpifl(jfl) - FLOAT(iafl) 
    102             zbfl  = tpjfl(jfl) - FLOAT(ibfl) 
    103             zcfl  = tpkfl(jfl) - FLOAT(icfl) 
    104 # if defined key_mpp 
    105             IF( (iafl >= (mig(nldi)-jpizoom+1)) .AND. (iafl <= (mig(nlei)-jpizoom+1)) .AND.   & 
    106               (  ibfl >= (mjg(nldj)-jpjzoom+1)) .AND. (ibfl <= (mjg(nlej)-jpjzoom+1)) ) THEN 
    107  
    108                ! local index 
    109  
    110                iafloc  = iafl -(mig(1)-jpizoom+1) + 1 
    111                ibfloc  = ibfl -(mjg(1)-jpjzoom+1) + 1 
     92         IF( lk_mpp ) THEN 
     93            DO jfl = 1, jpnfl 
     94               iafl  = INT ( tpifl(jfl) ) 
     95               ibfl  = INT ( tpjfl(jfl) ) 
     96               icfl  = INT ( tpkfl(jfl) ) 
     97               iafln = NINT( tpifl(jfl) ) 
     98               ibfln = NINT( tpjfl(jfl) ) 
     99               ia1fl = iafl + 1 
     100               ib1fl = ibfl + 1 
     101               ic1fl = icfl + 1 
     102               zafl  = tpifl(jfl) - FLOAT( iafl ) 
     103               zbfl  = tpjfl(jfl) - FLOAT( ibfl ) 
     104               zcfl  = tpkfl(jfl) - FLOAT( icfl ) 
     105               IF(   iafl >= mig(nldi)-jpizoom+1 .AND. iafl <= mig(nlei)-jpizoom+1 .AND.   & 
     106                  &  ibfl >= mjg(nldj)-jpjzoom+1 .AND. ibfl <= mjg(nlej)-jpjzoom+1       ) THEN 
     107 
     108                  ! local index 
     109 
     110                  iafloc  = iafl -(mig(1)-jpizoom+1) + 1 
     111                  ibfloc  = ibfl -(mjg(1)-jpjzoom+1) + 1 
     112                  ia1floc = iafloc + 1 
     113                  ib1floc = ibfloc + 1 
     114 
     115                  flyy(jfl) = (1.-zafl)*(1.-zbfl)*gphit(iafloc ,ibfloc ) + (1.-zafl) * zbfl * gphit(iafloc ,ib1floc)   & 
     116                     &      +     zafl *(1.-zbfl)*gphit(ia1floc,ibfloc ) +     zafl  * zbfl * gphit(ia1floc,ib1floc) 
     117                  flxx(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc)   & 
     118                     &      +     zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) +     zafl  * zbfl * glamt(ia1floc,ib1floc) 
     119                  flzz(jfl) = (1.-zcfl)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl) 
     120 
     121                  ! Change  by Alexandra Bozec et Jean-Philippe Boulanger 
     122                  ! We save  the instantaneous profile of T and S of the column      
     123                  ! ztemp(jfl)=tn(iafloc,ibfloc,icfl) 
     124                  ! zsal(jfl)=sn(iafloc,ibfloc,icfl) 
     125                  ztemp(1:jpk,jfl) = tn(iafloc,ibfloc,1:jpk) 
     126                  zsal (1:jpk,jfl) = sn(iafloc,ibfloc,1:jpk)             
     127               ELSE 
     128                  flxx(jfl) = 0. 
     129                  flyy(jfl) = 0. 
     130                  flzz(jfl) = 0. 
     131                  ztemp(1:jpk,jfl) = 0. 
     132                  zsal (1:jpk,jfl) = 0. 
     133               ENDIF 
     134            END DO 
     135 
     136            CALL mpp_sum( flxx, jpnfl )   ! sums over the global domain 
     137            CALL mpp_sum( flyy, jpnfl ) 
     138            CALL mpp_sum( flzz, jpnfl ) 
     139            ! these 2 lines have accendentaly been removed from ATL6-V8 run hence 
     140            ! giving 0 salinity and temperature on the float trajectory 
     141            CALL mpp_sum( ztemp, jpk*jpnfl ) 
     142            CALL mpp_sum( zsal , jpk*jpnfl ) 
     143 
     144         ELSE 
     145            DO jfl = 1, jpnfl 
     146               iafl  = INT (tpifl(jfl)) 
     147               ibfl  = INT (tpjfl(jfl)) 
     148               icfl  = INT (tpkfl(jfl)) 
     149               iafln = NINT(tpifl(jfl)) 
     150               ibfln = NINT(tpjfl(jfl)) 
     151               ia1fl = iafl+1 
     152               ib1fl = ibfl+1 
     153               ic1fl = icfl+1 
     154               zafl  = tpifl(jfl) - FLOAT(iafl) 
     155               zbfl  = tpjfl(jfl) - FLOAT(ibfl) 
     156               zcfl  = tpkfl(jfl) - FLOAT(icfl) 
     157               iafloc  = iafl 
     158               ibfloc  = ibfl 
    112159               ia1floc = iafloc + 1 
    113160               ib1floc = ibfloc + 1 
    … …  
    118165                         +     zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) +     zafl  * zbfl * glamt(ia1floc,ib1floc) 
    119166               flzz(jfl) = (1.-zcfl)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl) 
    120  
     167               !ALEX 
     168               ! Astuce pour ne pas avoir des flotteurs qui se baladent sur IDL 
     169               zxxu_11 = glamt(iafloc ,ibfloc ) 
     170               zxxu_10 = glamt(iafloc ,ib1floc) 
     171               zxxu_01 = glamt(ia1floc,ibfloc ) 
     172               zxxu    = glamt(ia1floc,ib1floc) 
     173 
     174               IF( iafloc == 52 )  zxxu_10 = -181 
     175               IF( iafloc == 52 )  zxxu_11 = -181 
     176               flxx(jfl)=(1.-zafl)*(1.-zbfl)* zxxu_11 + (1.-zafl)*    zbfl * zxxu_10   & 
     177                        +    zafl *(1.-zbfl)* zxxu_01 +     zafl *    zbfl * zxxu 
     178               !ALEX          
    121179               ! Change  by Alexandra Bozec et Jean-Philippe Boulanger 
    122180               ! We save  the instantaneous profile of T and S of the column      
    123                ! ztemp(jfl)=tn(iafloc,ibfloc,icfl) 
    124                ! zsal(jfl)=sn(iafloc,ibfloc,icfl) 
     181               !     ztemp(jfl)=tn(iafloc,ibfloc,icfl) 
     182               !     zsal(jfl)=sn(iafloc,ibfloc,icfl) 
    125183               ztemp(1:jpk,jfl) = tn(iafloc,ibfloc,1:jpk) 
    126                zsal (1:jpk,jfl) = sn(iafloc,ibfloc,1:jpk)             
    127             ELSE 
    128                flxx(jfl) = 0. 
    129                flyy(jfl) = 0. 
    130                flzz(jfl) = 0. 
    131                ztemp(1:jpk,jfl) = 0. 
    132                zsal (1:jpk,jfl) = 0. 
    133             ENDIF 
    134 # else 
    135             iafloc  = iafl 
    136             ibfloc  = ibfl 
    137             ia1floc = iafloc + 1 
    138             ib1floc = ibfloc + 1 
    139             ! 
    140             flyy(jfl) = (1.-zafl)*(1.-zbfl)*gphit(iafloc ,ibfloc ) + (1.-zafl) * zbfl * gphit(iafloc ,ib1floc)   & 
    141                       +     zafl *(1.-zbfl)*gphit(ia1floc,ibfloc ) +     zafl  * zbfl * gphit(ia1floc,ib1floc) 
    142             flxx(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc)   & 
    143                       +     zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) +     zafl  * zbfl * glamt(ia1floc,ib1floc) 
    144             flzz(jfl) = (1.-zcfl)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl) 
    145             !ALEX 
    146             ! Astuce pour ne pas avoir des flotteurs qui se baladent sur IDL 
    147             zxxu_11 = glamt(iafloc ,ibfloc ) 
    148             zxxu_10 = glamt(iafloc ,ib1floc) 
    149             zxxu_01 = glamt(ia1floc,ibfloc ) 
    150             zxxu    = glamt(ia1floc,ib1floc) 
    151  
    152             IF( iafloc == 52 )  zxxu_10 = -181 
    153             IF( iafloc == 52 )  zxxu_11 = -181 
    154             flxx(jfl)=(1.-zafl)*(1.-zbfl)* zxxu_11 + (1.-zafl)*    zbfl * zxxu_10   & 
    155                      +    zafl *(1.-zbfl)* zxxu_01 +     zafl *    zbfl * zxxu 
    156             !ALEX          
    157             ! Change  by Alexandra Bozec et Jean-Philippe Boulanger 
    158             ! We save  the instantaneous profile of T and S of the column      
    159             !     ztemp(jfl)=tn(iafloc,ibfloc,icfl) 
    160             !     zsal(jfl)=sn(iafloc,ibfloc,icfl) 
    161             ztemp(1:jpk,jfl) = tn(iafloc,ibfloc,1:jpk) 
    162             zsal (1:jpk,jfl) = sn(iafloc,ibfloc,1:jpk) 
    163 # endif 
    164          END DO 
    165  
    166 # if defined key_mpp 
    167          CALL mpp_sum( flxx, jpnfl ) 
    168          CALL mpp_sum( flyy, jpnfl ) 
    169          CALL mpp_sum( flzz, jpnfl ) 
    170          ! these 2 lines have accendentaly been removed from ATL6-V8 run hence 
    171          ! giving 0 salinity and temperature on the float trajectory 
    172          CALL mpp_sum( ztemp, jpk*jpnfl ) 
    173          CALL mpp_sum( zsal , jpk*jpnfl ) 
    174  
    175 # endif 
     184               zsal (1:jpk,jfl) = sn(iafloc,ibfloc,1:jpk) 
     185            END DO 
     186         ENDIF 
     187 
    176188         ! 
    177189         WRITE(numflo) flxx,flyy,flzz,nisobfl,ngrpfl,ztemp,zsal, FLOAT(ndastp) 
    … …  
    187199      !         iafln=NINT(tpifl(jfl)) 
    188200      !         ibfln=NINT(tpjfl(jfl)) 
    189       !# if defined key_mpp 
     201      !# if defined key_mpp_mpi   ||   defined key_mpp_shmem 
    190202      !        IF ( (iafl >= (mig(nldi)-jpizoom+1)) .AND. 
    191203      !     $       (iafl <= (mig(nlei)-jpizoom+1)) .AND. 
    … …  
    206218      !         ztemp(jfl)=tn(iafloc,ibfloc,jk) 
    207219      !         zsal(jfl)=sn(iaflo!,ibfloc,jk) 
    208       !# if defined key_mpp 
     220      !# if defined key_mpp_mpi   ||   defined key_mpp_shmem 
    209221      !        ELSE 
    210222      !         ztemp(jfl) = 0. 
    … …  
    214226      !! ... next float 
    215227      !        END DO 
    216       !#if defined key_mpp 
    217       !      CALL mpp_sum( ztemp, jpnfl ) 
    218       !      CALL mpp_sum( zsal , jpnfl ) 
    219       !# endif 
     228      !      IF( lk_mpp )   CALL mpp_sum( ztemp, jpnfl ) 
     229      !      IF( lk_mpp )   CALL mpp_sum( zsal , jpnfl ) 
     230      ! 
    220231      !      IF (lwp) THEN  
    221232      !         WRITE(numflo) ztemp, zsal 
    … …  
    268279         ! Compute the number of trajectories for each processor 
    269280         ! 
    270 # if defined key_mpp 
    271          DO jfl = 1, jpnfl 
    272             IF( (INT(tpifl(jfl)) >= (mig(nldi)-jpizoom+1)) .AND.   & 
    273               (  INT(tpifl(jfl)) <= (mig(nlei)-jpizoom+1)) .AND.   & 
    274               (  INT(tpjfl(jfl)) >= (mjg(nldj)-jpjzoom+1)) .AND.   & 
    275               (  INT(tpjfl(jfl)) <= (mjg(nlej)-jpjzoom+1)) ) THEN 
    276                iproc(narea) = iproc(narea)+1 
    277             ENDIF 
    278          END DO 
    279          CALL mpp_sum( iproc, jpnij ) 
    280          ! 
    281          IF(lwp) THEN  
    282             WRITE(numout,*) 'DATE',adatrj 
    283             DO jpn = 1, jpnij 
    284                IF( iproc(jpn) /= 0 ) THEN 
    285                   WRITE(numout,*)'PROCESSOR',jpn-1,'compute',iproc(jpn), 'trajectories.' 
     281         IF( lk_mpp ) THEN 
     282            DO jfl = 1, jpnfl 
     283               IF( (INT(tpifl(jfl)) >= (mig(nldi)-jpizoom+1)) .AND.   & 
     284                  &(INT(tpifl(jfl)) <= (mig(nlei)-jpizoom+1)) .AND.   & 
     285                  &(INT(tpjfl(jfl)) >= (mjg(nldj)-jpjzoom+1)) .AND.   & 
     286                  &(INT(tpjfl(jfl)) <= (mjg(nlej)-jpjzoom+1)) ) THEN 
     287                  iproc(narea) = iproc(narea)+1 
    286288               ENDIF 
    287289            END DO 
    288          ENDIF 
    289 # endif 
     290            CALL mpp_sum( iproc, jpnij ) 
     291            ! 
     292            IF(lwp) THEN  
     293               WRITE(numout,*) 'DATE',adatrj 
     294               DO jpn = 1, jpnij 
     295                  IF( iproc(jpn) /= 0 ) THEN 
     296                     WRITE(numout,*)'PROCESSOR',jpn-1,'compute',iproc(jpn), 'trajectories.' 
     297                  ENDIF 
     298               END DO 
     299            ENDIF 
     300         ENDIF 
    290301      ENDIF  
    291302 

  • trunk/NEMO/OPA_SRC/SOL/sol_oce.F90

    r3 r16  
    1616 
    1717   IMPLICIT NONE 
     18   PRIVATE 
    1819 
    19    !!---------------------------------------------------------------------- 
     20   !!----------------------------------- 
    2021   !! elliptic solver: SOR, PCG or FETI 
    21    !! --------------------------------------------------- 
    22    INTEGER  ::              & !!! namsol   elliptic solver / island / free surface 
    23       nsolv =    1 ,        &  ! = 1/2/3 type of elliptic solver 
    24       nmax  =  800 ,        &  ! maximum of iterations for the solver 
    25       nmisl = 4000             ! maximum pcg iterations for island 
     22   !! ---------------------------------- 
     23   INTEGER , PUBLIC ::      & !!: namsol   elliptic solver / island / free surface 
     24      nsolv =    1 ,        &  !: = 1/2/3 type of elliptic solver 
     25      nmax  =  800 ,        &  !: maximum of iterations for the solver 
     26      nmisl = 4000             !: maximum pcg iterations for island 
    2627      
    27    REAL(wp) ::              & !!! namsol   elliptic solver / island / free surface 
    28       eps    = 1.e-6_wp ,   &  ! absolute precision of the solver 
    29       sor    = 1.76_wp  ,   &  ! optimal coefficient for sor solver 
    30       epsisl = 1.e-10_wp,   &  ! absolute precision on stream function solver 
    31       rnu    = 1.0_wp          ! strength of the additional force used in free surface 
     28   REAL(wp), PUBLIC ::      & !!: namsol   elliptic solver / island / free surface 
     29      eps    = 1.e-6_wp ,   &  !: absolute precision of the solver 
     30      sor    = 1.76_wp  ,   &  !: optimal coefficient for sor solver 
     31      epsisl = 1.e-10_wp,   &  !: absolute precision on stream function solver 
     32      rnu    = 1.0_wp          !: strength of the additional force used in free surface 
    3233 
    33    INTEGER  ::   & 
    34       ncut,         &  ! indicator of solver convergence 
    35       niter            ! number of iteration done by the solver 
     34   CHARACTER(len=1), PUBLIC ::   &  !: 
     35      c_solver_pt = 'T'        !: nature of grid-points T (S) for free surface case 
     36      !                        !                       F (G) for rigid-lid case 
    3637 
    37    REAL(wp) ::   & 
    38       epsr,         &  ! relative precision for SOR & PCG solvers 
    39       epsilo,       &  ! precision for the FETI solver 
    40       rnorme, res,  &  ! intermediate modulus, solver residu 
    41       alph,         &  ! coefficient  =(gcr,gcr)/(gcx,gccd) 
    42       beta,         &  ! coefficient  =(rn+1,rn+1)/(rn,rn) 
    43       radd,         &  ! coefficient  =(gccd,gcdes) 
    44       rr               ! coefficient  =(rn,rn) 
     38   INTEGER , PUBLIC ::   &  !: 
     39      ncut,         &  !: indicator of solver convergence 
     40      niter            !: number of iteration done by the solver 
    4541 
    46    REAL(wp), DIMENSION(jpi,jpj,4) ::   & 
    47       gcp              ! barotropic matrix extra-diagonal elements 
     42   REAL(wp), PUBLIC ::   &  !: 
     43      epsr,         &  !: relative precision for SOR & PCG solvers 
     44      epsilo,       &  !: precision for the FETI solver 
     45      rnorme, res,  &  !: intermediate modulus, solver residu 
     46      alph,         &  !: coefficient  =(gcr,gcr)/(gcx,gccd) 
     47      beta,         &  !: coefficient  =(rn+1,rn+1)/(rn,rn) 
     48      radd,         &  !: coefficient  =(gccd,gcdes) 
     49      rr               !: coefficient  =(rn,rn) 
    4850 
    49    REAL(wp), DIMENSION(jpi,jpj) ::   & 
    50       gcx, gcxb,    &  ! now, before solution of the elliptic equation 
    51       gcdprc,       &  ! inverse diagonal preconditioning matrix 
    52       gcdmat,       &  ! diagonal preconditioning matrix 
    53       gcb,          &  ! second member of the barotropic linear system 
    54       gcr,          &  ! residu =b-a.x 
    55       gcdes,        &  ! vector descente 
    56       gccd             ! vector such that ca.gccd=a.d (ca-1=gcdprc) 
     51   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,4) ::   &  !: 
     52      gcp              !: barotropic matrix extra-diagonal elements 
     53 
     54   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  !: 
     55      gcx, gcxb,    &  !: now, before solution of the elliptic equation 
     56      gcdprc,       &  !: inverse diagonal preconditioning matrix 
     57      gcdmat,       &  !: diagonal preconditioning matrix 
     58      gcb,          &  !: second member of the barotropic linear system 
     59      gcr,          &  !: residu =b-a.x 
     60      gcdes,        &  !: vector descente 
     61      gccd             !: vector such that ca.gccd=a.d (ca-1=gcdprc) 
    5762 
    5863#if defined key_feti 
    … …  
    6772   !!      malistin()       : concatened list of interface nodes 
    6873 
    69    INTEGER :: nim,nxm,   & 
     74   INTEGER, PUBLIC :: nim,nxm,   & 
    7075       malxm,malim,malxmax,malimax,   & 
    7176       nifmat,njfmat,nelem,npe,matopo,   & 
    … …  
    8590       madwork 
    8691 
    87    INTEGER :: mfet(jpi*jpj+2*jpi+2*jpj+51) 
     92   INTEGER, PUBLIC :: mfet(jpi*jpj+2*jpi+2*jpj+51) 
    8893 
    89    REAL(wp) ::  wfeti(jpj*jpi*jpi+13*jpi*jpj+19*(jpi+jpj)   & 
     94   REAL(wp), PUBLIC ::   &  !: 
     95      wfeti(jpj*jpi*jpi+13*jpi*jpj+19*(jpi+jpj)   & 
    9096       +4*jpnij+33   & 
    9197       +2*(jpi+jpj)*(jpnij-jpni)*jpi   & 
    … …  
    94100       +3*(jpnij-jpnj+jperio)*jpj)  
    95101 
    96    REAL(wp) ::   res2, rcompt 
     102   REAL(wp), PUBLIC ::   res2, rcompt 
    97103 
    98104#endif 

  • trunk/NEMO/OPA_SRC/SOL/solfet.F90

    r3 r16  
    3333      !!     Solve the ellipic equation for the barotropic stream function 
    3434      !!     system (default option) or the transport divergence system 
    35       !!     ("key_dynspg_fsc") using a Finite Elements Tearing &  
     35      !!     (lk_dynspg_fsc=T) using a Finite Elements Tearing and  
    3636      !!      Interconnecting (FETI) approach. 
    3737      !!     In the former case, the barotropic stream function trend has a 
    … …  
    142142      CALL feti_vmov( noeuds, wfeti(miax), gcx ) 
    143143 
    144       ! boundary conditions   !!bug ???  check  arguments... 
    145 #   if defined key_dynspg_fsc 
    146 #      if defined key_mpp 
    147       !   Mpp: export boundary values to neighbouring processors 
    148       CALL lbc_lnk( gcx, 'S', 1. ) 
    149 #      else 
    150       !   mono- or macro-tasking: W-point, >0, 2D array, no slab 
    151       IF( nperio /= 0 ) THEN 
    152          CALL lbc_lnk( gcx, 'T', 1. ) 
    153       ENDIF 
    154 #      endif 
    155 #   else 
    156 #      if defined key_mpp 
    157       !   Mpp: export boundary values to neighbouring processors 
    158       CALL lbc_lnk( gcx, 'G', 1. ) 
    159 #      else 
    160       !   mono- or macro-tasking: W-point, >0, 2D array, no slab 
    161       IF( nperio /= 0 ) THEN 
    162          CALL lbc_lnk( gcx, 'F', 1. ) 
    163       ENDIF 
    164 #      endif 
    165 #   endif 
     144      CALL lbc_lnk( gcx, c_solver_pt, 1. )   ! lateral boundary condition 
    166145 
    167146   END SUBROUTINE sol_fet 

  • trunk/NEMO/OPA_SRC/SOL/solisl.F90

    r3 r16  
    3636 
    3737   !! * Shared module variables 
    38    LOGICAL, PUBLIC ::   & 
    39       l_isl = .TRUE.          ! 'key_islands' flag 
     38   LOGICAL, PUBLIC, PARAMETER ::   l_isl = .TRUE.    !: 'key_islands' flag 
    4039 
    4140   !! * module variable 
    … …  
    157156         zwb(jpi,:) = 0.e0 
    158157      ENDIF 
    159 # if defined key_mpp 
    160       ! Mpp: export boundary values to neighboring processors 
    161       CALL lbc_lnk( zwb, 'G', 1. ) 
    162 # endif 
     158      IF( lk_mpp )   CALL lbc_lnk( zwb, 'G', 1. ) 
    163159 
    164160 
    165161      ! 1. Initialization for the search of island grid-points 
    166162      ! ------------------------------------------------------ 
    167 # if defined key_mpp 
    168  
    169       ! Mpp : The overlap region are not taken into account 
    170       ! (islands bondaries are searched over subdomain only) 
    171       iista =  1   + jpreci 
    172       iiend = nlci - jpreci 
    173       ijsta =  1   + jprecj 
    174       ijend = nlcj - jprecj 
    175       ijstm1=  1   + jprecj 
    176       ijenm1= nlcj - jprecj 
    177       IF( nbondi == -1 .OR. nbondi == 2 ) THEN 
     163 
     164      IF( lk_mpp ) THEN 
     165 
     166         ! Mpp : The overlap region are not taken into account 
     167         ! (islands bondaries are searched over subdomain only) 
     168         iista =  1   + jpreci 
     169         iiend = nlci - jpreci 
     170         ijsta =  1   + jprecj 
     171         ijend = nlcj - jprecj 
     172         ijstm1=  1   + jprecj 
     173         ijenm1= nlcj - jprecj 
     174         IF( nbondi == -1 .OR. nbondi == 2 ) THEN 
     175            iista  = 1 
     176         ENDIF 
     177         IF( nbondi ==  1 .OR. nbondi == 2 ) THEN 
     178            iiend  = nlci 
     179         ENDIF 
     180         IF( nbondj == -1 .OR. nbondj == 2 ) THEN 
     181            ijsta  = 1 
     182            ijstm1 = 2 
     183         ENDIF 
     184         IF( nbondj ==  1 .OR. nbondj == 2 ) THEN 
     185            ijend  = nlcj 
     186            ijenm1 = nlcj-1 
     187         ENDIF 
     188         IF( npolj == 3 .OR. npolj == 4 ) THEN 
     189            ijend  = nlcj-2 
     190            ijenm1 = nlcj-2 
     191         ENDIF  
     192      ELSE 
     193         ! mono- or macro-tasking environnement: full domain scan 
    178194         iista  = 1 
    179       ENDIF 
    180       IF( nbondi ==  1 .OR. nbondi == 2 ) THEN 
    181          iiend  = nlci 
    182       ENDIF 
    183       IF( nbondj == -1 .OR. nbondj == 2 ) THEN 
     195         iiend  = jpi 
    184196         ijsta  = 1 
    185197         ijstm1 = 2 
    186       ENDIF 
    187       IF( nbondj ==  1 .OR. nbondj == 2 ) THEN 
    188          ijend  = nlcj 
    189          ijenm1 = nlcj-1 
    190       ENDIF 
    191       IF( npolj == 3 .OR. npolj == 4 ) THEN 
    192          ijend  = nlcj-2 
    193          ijenm1 = nlcj-2 
    194       ENDIF  
    195 # else 
    196  
    197       ! mono- or macro-tasking environnement: full domain scan 
    198       iista  = 1 
    199       iiend  = jpi 
    200       ijsta  = 1 
    201       ijstm1 = 2 
    202       IF( nperio == 3 .OR. nperio == 4 ) THEN 
    203          ijend  = jpj-2 
    204          ijenm1 = jpj-2 
    205       ELSEIF( nperio == 5 .OR. nperio == 6 ) THEN 
    206          ijend  = jpj-1 
    207          ijenm1 = jpj-1 
    208       ELSE 
    209          ijend  = jpj 
    210          ijenm1 = jpj-1 
    211       ENDIF 
    212 # endif 
     198         IF( nperio == 3 .OR. nperio == 4 ) THEN 
     199            ijend  = jpj-2 
     200            ijenm1 = jpj-2 
     201         ELSEIF( nperio == 5 .OR. nperio == 6 ) THEN 
     202            ijend  = jpj-1 
     203            ijenm1 = jpj-1 
     204         ELSE 
     205            ijend  = jpj 
     206            ijenm1 = jpj-1 
     207         ENDIF 
     208      ENDIF 
    213209 
    214210 
    … …  
    247243            inilt = inilt + indil(jj) 
    248244         END DO 
    249 # if defined key_mpp 
    250          CALL mpp_sum( inilt ) 
    251 # endif 
     245         IF( lk_mpp )   CALL mpp_sum( inilt )   ! sum over the global domain 
     246 
    252247         IF( inilt == 0 ) THEN 
    253248            IF(lwp) THEN 
    … …  
    255250               WRITE(numout,*) ' change parameter.h' 
    256251            ENDIF 
    257             STOP 'isldom' 
     252            STOP 'isldom'      !cr replace by nstop 
    258253         ENDIF 
    259254          
    … …  
    381376         ! Take account of redundant points 
    382377          
    383 # if defined key_mpp 
    384          CALL mpp_sum( ip ) 
    385 # endif 
     378         IF( lk_mpp )   CALL mpp_sum( ip )   ! sum over the global domain 
    386379          
    387380         IF( ip > jpnisl ) THEN 
    … …  
    391384               WRITE(numout,*) ' change parameter.h' 
    392385            ENDIF 
    393             STOP 'isldom' 
     386            STOP 'isldom'    !cr => nstop 
    394387         ENDIF 
    395388          
    … …  
    409402 
    410403      inilt = isrchne( jpij, zwb(1,1), 1, 0. ) 
    411 # if defined key_mpp 
    412       CALL mpp_min( inilt ) 
    413 # endif 
     404      IF( lk_mpp )   CALL mpp_min( inilt )   ! min over the global domain 
    414405 
    415406      IF( inilt /= jpij+1 ) THEN 
    … …  
    426417      ! ---------------------------------------- 
    427418 
    428       CALL islpri 
     419      CALL isl_pri 
    429420 
    430421 
    … …  
    432423      ! ------------------------------------------------------- 
    433424 
    434       CALL islpth 
     425      CALL isl_pth 
    435426 
    436427   END SUBROUTINE isl_dom 
    … …  
    466457         ipe = mnisl(3,jni) 
    467458         ipw = mnisl(4,jni) 
    468 # if defined key_mpp 
    469          CALL mpp_sum( ip  ) 
    470          CALL mpp_sum( ipn ) 
    471          CALL mpp_sum( ips ) 
    472          CALL mpp_sum( ipe ) 
    473          CALL mpp_sum( ipw ) 
    474 # endif 
     459         IF( lk_mpp ) THEN 
     460            CALL mpp_sum( ip  )   ! sums over the global domain 
     461            CALL mpp_sum( ipn ) 
     462            CALL mpp_sum( ips ) 
     463            CALL mpp_sum( ipe ) 
     464            CALL mpp_sum( ipw ) 
     465         ENDIF 
    475466         IF(lwp) THEN 
    476467            WRITE(numout,9000) jni 
    … …  
    484475      END DO 
    485476 
    486       ! FORMAT  
    487  
     477      ! FORMAT   !!cr => no more format 
    488478 9000 FORMAT(/, /, 'island number= ', i2 ) 
    489479 9010 FORMAT(/, 'npil=',i4,' npn=',i3,' nps=',i3,' npe=',i3,' npw=',i3 ) 
    … …  
    514504      !!---------------------------------------------------------------------- 
    515505      !! * Local declarations 
    516       INTEGER ::   ji, jj, jni, jii, jnp    ! dummy loop indices 
    517       INTEGER ::   ii, ij                   ! temporary integers 
     506      INTEGER ::   jni, jii, jnp    ! dummy loop indices 
     507      INTEGER ::   ii, ij           ! temporary integers 
    518508      !!---------------------------------------------------------------------- 
    519509       
    … …  
    587577      REAL(wp), DIMENSION(jpi,jpj) ::   zlamt, zphit 
    588578      REAL(wp), DIMENSION(jpi,jpj,2) ::   zwx 
    589 # if defined key_mpp 
    590579      REAL(wp), DIMENSION(jpisl*jpisl) ::   ztab 
    591 # endif 
    592580      !!---------------------------------------------------------------------- 
    593581 
    … …  
    674662          
    675663      END DO 
    676 # if defined key_mpp 
    677       DO jnj=1,jpisl 
    678          DO jni=1,jpisl 
    679             ztab(jni+(jnj-1)*jpisl) = aisl(jni,jnj) 
    680          END DO 
    681       END DO 
    682  
    683       CALL mpp_sum( ztab, jpisl*jpisl ) 
    684 !!    CALL mpp_sum( aisl, jpisl*jpisl ) 
    685 # endif 
     664      IF( lk_mpp ) THEN 
     665         DO jnj = 1, jpisl 
     666            DO jni = 1, jpisl 
     667               ztab(jni+(jnj-1)*jpisl) = aisl(jni,jnj) 
     668            END DO 
     669         END DO 
     670         CALL mpp_sum( ztab, jpisl*jpisl )   ! sum over the global domain 
     671!!       CALL mpp_sum( aisl, jpisl*jpisl ) 
     672      ENDIF 
    686673 
    687674      ! 1.3 Control print 
    … …  
    775762      REAL(wp) ::   zep(jpisl), zlamt(jpi,jpj), zphit(jpi,jpj), zdept(1), zprec(4) 
    776763      REAL(wp) ::   zdate0, zdt 
    777 # if defined key_mpp 
     764      REAL(wp) ::   t2p1(jpi,1,1) 
    778765      INTEGER  ::   iloc 
    779 # endif 
    780766      !!---------------------------------------------------------------------- 
    781767 
    … …  
    907893         ! Right hand side of the streamfunction equation 
    908894          
    909 # if defined key_mpp 
    910  
    911          ! north fold treatment 
    912          IF( npolj == 3 .OR. npolj == 5)   iloc=jpiglo-(nimpp-1+nimppt(nono+1)-1) 
    913          IF( npolj == 4 .OR. npolj == 6)   iloc=jpiglo-2*(nimpp-1) 
    914          t2p1(:,1,1) = 0.e0 
    915          ! north and south grid-points 
    916          DO jii = 1, 2 
    917             DO jnp = 1, mnisl(jii,jni) 
    918                ii = miisl(jnp,jii,jni) 
    919                ij = mjisl(jnp,jii,jni) 
    920                IF( ( npolj == 3 .OR. npolj == 4 ) .AND.   & 
    921                   ( ij == nlcj-1 .AND. jii == 1) ) THEN  
    922                   iju=iloc-ii+1 
    923                   t2p1(iju,1,1) =  t2p1(iju,1,1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij)  
    924                ELSEIF( ( npolj == 5 .OR. npolj == 6 ) .AND.   & 
    925                   ( ij == nlcj-1 .AND. jii == 1) ) THEN  
    926                   iju=iloc-ii 
    927                   gcb(ii,ij) =  gcb(ii,ij) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij)  
    928                   t2p1(iju,1,1) =  t2p1(iju,1,1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij)  
    929                ELSE   
    930                   gcb(ii,ij-jii+1) =  gcb(ii,ij-jii+1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij)  
    931                ENDIF 
    932             END DO 
    933          END DO 
    934           
    935          ! east and west grid-points 
    936           
    937          DO jii = 3, 4 
    938             DO jnp = 1, mnisl(jii,jni) 
    939                ii = miisl(jnp,jii,jni) 
    940                ij = mjisl(jnp,jii,jni) 
    941                gcb(ii-jii+3,ij) = gcb(ii-jii+3,ij) + hvr(ii,ij) * e2v(ii,ij) / e1v(ii,ij) 
    942             END DO 
    943          END DO 
    944          CALL mpplnks( gcb ) 
    945  
    946 # else 
    947  
    948          ! north and south grid-points 
    949          DO jii = 1, 2 
    950             DO jnp = 1, mnisl(jii,jni) 
    951                ii = miisl(jnp,jii,jni) 
    952                ij = mjisl(jnp,jii,jni) 
    953                IF( ( nperio == 3 .OR. nperio == 4 ) .AND.   & 
    954                   ( ij == jpj-1 .AND. jii == 1) ) THEN  
    955                   gcb(jpi-ii+1,ij-1) = gcb(jpi-ii+1,ij-1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij)  
    956                ELSEIF( ( nperio == 5 .OR. nperio == 6 ) .AND.   & 
    957                   ( ij == jpj-1 .AND. jii == 1) ) THEN  
    958                   gcb(ii,ij) =  gcb(ii,ij) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 
    959                   gcb(jpi-ii,ij) = gcb(jpi-ii,ij) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij)  
    960                ELSE   
    961                   gcb(ii,ij-jii+1) =  gcb(ii,ij-jii+1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 
    962                ENDIF 
    963             END DO 
    964          END DO 
    965  
    966          ! east and west grid-points 
    967          DO jii = 3, 4 
    968             DO jnp = 1, mnisl(jii,jni) 
    969                ii = miisl(jnp,jii,jni) 
    970                ij = mjisl(jnp,jii,jni) 
    971                IF( bmask(ii-jii+3,ij) /= 0. ) THEN 
     895         IF( lk_mpp ) THEN 
     896 
     897            ! north fold treatment 
     898            IF( npolj == 3 .OR. npolj == 5)   iloc=jpiglo-(nimpp-1+nimppt(nono+1)-1) 
     899            IF( npolj == 4 .OR. npolj == 6)   iloc=jpiglo-2*(nimpp-1) 
     900            t2p1(:,1,1) = 0.e0 
     901            ! north and south grid-points 
     902            DO jii = 1, 2 
     903               DO jnp = 1, mnisl(jii,jni) 
     904                  ii = miisl(jnp,jii,jni) 
     905                  ij = mjisl(jnp,jii,jni) 
     906                  IF( ( npolj == 3 .OR. npolj == 4 ) .AND.   & 
     907                     ( ij == nlcj-1 .AND. jii == 1) ) THEN  
     908                     iju=iloc-ii+1 
     909                     t2p1(iju,1,1) =  t2p1(iju,1,1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij)  
     910                  ELSEIF( ( npolj == 5 .OR. npolj == 6 ) .AND.   & 
     911                     ( ij == nlcj-1 .AND. jii == 1) ) THEN  
     912                     iju=iloc-ii 
     913                     gcb(ii,ij) =  gcb(ii,ij) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij)  
     914                     t2p1(iju,1,1) =  t2p1(iju,1,1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij)  
     915                  ELSE   
     916                     gcb(ii,ij-jii+1) =  gcb(ii,ij-jii+1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij)  
     917                  ENDIF 
     918               END DO 
     919            END DO 
     920          
     921            ! east and west grid-points 
     922          
     923            DO jii = 3, 4 
     924               DO jnp = 1, mnisl(jii,jni) 
     925                  ii = miisl(jnp,jii,jni) 
     926                  ij = mjisl(jnp,jii,jni) 
    972927                  gcb(ii-jii+3,ij) = gcb(ii-jii+3,ij) + hvr(ii,ij) * e2v(ii,ij) / e1v(ii,ij) 
    973                ELSE 
    974  
    975                   ! east-west cyclic boundary conditions 
    976                   IF( ii-jii+3 == 1 ) THEN 
    977                      gcb(jpim1,ij) = gcb(jpim1,ij) + hvr(ii,ij) * e2v(ii,ij) / e1v(ii,ij) 
     928               END DO 
     929            END DO 
     930 
     931            IF( lk_mpp )   CALL mpplnks( gcb )   !!bug ? should use an lbclnk ? is it possible? 
     932 
     933         ELSE 
     934 
     935            ! north and south grid-points 
     936            DO jii = 1, 2 
     937               DO jnp = 1, mnisl(jii,jni) 
     938                  ii = miisl(jnp,jii,jni) 
     939                  ij = mjisl(jnp,jii,jni) 
     940                  IF( ( nperio == 3 .OR. nperio == 4 ) .AND.   & 
     941                     ( ij == jpj-1 .AND. jii == 1) ) THEN  
     942                     gcb(jpi-ii+1,ij-1) = gcb(jpi-ii+1,ij-1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij)  
     943                  ELSEIF( ( nperio == 5 .OR. nperio == 6 ) .AND.   & 
     944                     ( ij == jpj-1 .AND. jii == 1) ) THEN  
     945                     gcb(ii,ij) =  gcb(ii,ij) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 
     946                     gcb(jpi-ii,ij) = gcb(jpi-ii,ij) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij)  
     947                  ELSE   
     948                     gcb(ii,ij-jii+1) =  gcb(ii,ij-jii+1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 
    978949                  ENDIF 
    979                ENDIF 
    980             END DO 
    981          END DO 
    982  
    983 # endif 
     950               END DO 
     951            END DO 
     952 
     953            ! east and west grid-points 
     954            DO jii = 3, 4 
     955               DO jnp = 1, mnisl(jii,jni) 
     956                  ii = miisl(jnp,jii,jni) 
     957                  ij = mjisl(jnp,jii,jni) 
     958                  IF( bmask(ii-jii+3,ij) /= 0. ) THEN 
     959                     gcb(ii-jii+3,ij) = gcb(ii-jii+3,ij) + hvr(ii,ij) * e2v(ii,ij) / e1v(ii,ij) 
     960                  ELSE 
     961                     ! east-west cyclic boundary conditions 
     962                     IF( ii-jii+3 == 1 ) THEN 
     963                        gcb(jpim1,ij) = gcb(jpim1,ij) + hvr(ii,ij) * e2v(ii,ij) / e1v(ii,ij) 
     964                     ENDIF 
     965                  ENDIF 
     966               END DO 
     967            END DO 
     968         ENDIF 
    984969 
    985970         ! Preconditioned right hand side and absolute precision 
    … …  
    1011996               END DO 
    1012997            END DO 
    1013 # if defined key_mpp 
    1014             CALL mpp_sum( rnorme ) 
    1015 # endif 
     998            IF( lk_mpp )   CALL mpp_sum( rnorme )   ! sum over the global domain 
     999 
    10161000            IF(lwp) WRITE(numout,*) 'rnorme ', rnorme 
    10171001            epsr = epsisl * epsisl * rnorme 
    … …  
    10701054            END DO 
    10711055         ENDIF 
    1072 # if defined key_mpp 
    1073          CALL lbc_lnk( bsfisl(:,:,jni), 'G', 1. ) 
    1074 # endif 
     1056         IF( lk_mpp )   CALL lbc_lnk( bsfisl(:,:,jni), 'G', 1. )   ! link at G-point 
    10751057 
    10761058 
    … …  
    12121194         END DO 
    12131195      END DO 
    1214 #   if defined key_mpp 
    1215       !  Mpp : global sum to obtain global dot from local ones 
    1216       CALL mpp_sum( bisl, jpisl ) 
    1217 #   endif 
     1196      IF( lk_mpp )   CALL mpp_sum( bisl, jpisl )   ! sum over the global domain 
     1197 
    12181198      DO jni = 1, jpisl                     ! Island stream function trend 
    12191199         visl(jni) = 0.e0 
    … …  
    12701250            zfact = 1.e-6 * bsfn(miisl(1,0,jni),mjisl(1,0,jni)) 
    12711251         ENDIF 
    1272 #      if defined key_mpp 
    1273          CALL mpp_isl( zfact ) 
    1274 #      endif 
     1252         IF( lk_mpp )   CALL mpp_isl( zfact ) 
     1253 
    12751254         IF(lwp) WRITE(numisp,9300) kt, jni, zfact, visl(jni) 
    12761255         IF( MOD( kt, nwrite ) == 0 .OR. kindic < 0     & 
    … …  
    12931272   !!   Default option                                         Empty module 
    12941273   !!---------------------------------------------------------------------- 
    1295    LOGICAL, PUBLIC ::   l_isl = .FALSE.    ! 'key_islands' flag 
     1274   LOGICAL, PUBLIC, PARAMETER ::   l_isl = .FALSE.    !: 'key_islands' flag 
    12961275CONTAINS 
    12971276   SUBROUTINE isl_dom                        ! Empty routine 
    … …  
    13041283   END SUBROUTINE isl_dyn_spg 
    13051284   SUBROUTINE isl_stp_ctl( kt, kindic )      ! Empty routine 
    1306       WRITE(*,*) kt, kindic                     ! no compilation warning 
     1285      WRITE(*,*) 'isl_stp_ctl: You should not have seen this print! error?', kt, kindic 
    13071286   END SUBROUTINE isl_stp_ctl 
    13081287#endif 

  • trunk/NEMO/OPA_SRC/SOL/solisl_fdir.h90

    r3 r16  
    109109 
    110110      END DO 
    111 #   if defined key_mpp 
    112       CALL mpp_sum( aisl, jpisl*jpisl ) 
    113 #   endif 
     111      IF( lk_mpp )   CALL mpp_sum( aisl, jpisl*jpisl )   ! sum over the global domain 
    114112 
    115113      ! 1.3 Control print 
    116        
    117114      IF(lwp) THEN 
    118115         WRITE(numout,*) 
    … …  
    296293         ! 1.2 Right hand side of the stream FUNCTION equation 
    297294          
    298 #    if defined key_mpp 
    299           
    300          ! north fold treatment 
    301          IF( npolj == 3 ) iloc = jpiglo -(nimpp-1+nimppt(nono+1)-1) 
    302          IF( npolj == 4 ) iloc = jpiglo - 2*(nimpp-1) 
    303          t2p1(:,1,1) = 0. 
    304          ! north and south grid-points 
    305          DO jii = 1, 2 
    306             DO jnp = 1, mnisl(jii,jni) 
    307                ii = miisl(jnp,jii,jni) 
    308                ij = mjisl(jnp,jii,jni) 
    309                IF( ( npolj == 3 .OR. npolj == 4 ) .AND. ( ij == nlcj-1 .AND. jii == 1) ) THEN  
    310                   iju=iloc-ii+1 
    311                   t2p1(iju,1,1) =  t2p1(iju,1,1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij)  
    312                ELSE   
    313                   gcb(ii,ij-jii+1) =  gcb(ii,ij-jii+1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij)  
    314                ENDIF 
    315             END DO 
    316          END DO 
    317           
    318          ! east and west grid-points 
    319  
    320          DO jii = 3, 4 
    321             DO jnp = 1, mnisl(jii,jni) 
    322                ii = miisl(jnp,jii,jni) 
    323                ij = mjisl(jnp,jii,jni) 
    324                gcb(ii-jii+3,ij) = gcb(ii-jii+3,ij) + hvr(ii,ij) * e2v(ii,ij) / e1v(ii,ij) 
    325             END DO 
    326          END DO 
    327          CALL mpplnks( gcb ) 
    328          
    329 #      else 
    330  
    331          ! north and south grid-points 
    332          DO jii = 1, 2 
    333             DO jnp = 1, mnisl(jii,jni) 
    334                ii = miisl(jnp,jii,jni) 
    335                ij = mjisl(jnp,jii,jni) 
    336                IF( ( nperio == 3 .OR. nperio == 4 ) .AND. ( ij == jpj-1 .AND. jii == 1) ) THEN  
    337                   gcb(jpi-ii+1,ij-1) = gcb(jpi-ii+1,ij-1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij)  
    338                ELSE   
    339                   gcb(ii,ij-jii+1) =  gcb(ii,ij-jii+1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 
    340                ENDIF 
    341             END DO 
    342          END DO 
    343  
    344          ! east and west grid-points 
    345          DO jii = 3, 4 
    346             DO jnp = 1, mnisl(jii,jni) 
    347                ii = miisl(jnp,jii,jni) 
    348                ij = mjisl(jnp,jii,jni) 
    349                IF( bmask(ii-jii+3,ij) /= 0. ) THEN 
     295         IF( lk_mpp ) THEN 
     296            ! north fold treatment 
     297            IF( npolj == 3 ) iloc = jpiglo -(nimpp-1+nimppt(nono+1)-1) 
     298            IF( npolj == 4 ) iloc = jpiglo - 2*(nimpp-1) 
     299            t2p1(:,1,1) = 0. 
     300            ! north and south grid-points 
     301            DO jii = 1, 2 
     302               DO jnp = 1, mnisl(jii,jni) 
     303                  ii = miisl(jnp,jii,jni) 
     304                  ij = mjisl(jnp,jii,jni) 
     305                  IF( ( npolj == 3 .OR. npolj == 4 ) .AND. ( ij == nlcj-1 .AND. jii == 1) ) THEN  
     306                     iju=iloc-ii+1 
     307                     t2p1(iju,1,1) =  t2p1(iju,1,1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij)  
     308                  ELSE   
     309                     gcb(ii,ij-jii+1) =  gcb(ii,ij-jii+1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij)  
     310                  ENDIF 
     311               END DO 
     312            END DO 
     313          
     314            ! east and west grid-points 
     315 
     316            DO jii = 3, 4 
     317               DO jnp = 1, mnisl(jii,jni) 
     318                  ii = miisl(jnp,jii,jni) 
     319                  ij = mjisl(jnp,jii,jni) 
    350320                  gcb(ii-jii+3,ij) = gcb(ii-jii+3,ij) + hvr(ii,ij) * e2v(ii,ij) / e1v(ii,ij) 
    351                ELSE 
    352                   ! east-west cyclic boundary conditions 
    353                   IF( ii-jii+3 == 1 ) THEN 
    354                      gcb(jpim1,ij) = gcb(jpim1,ij) + hvr(ii,ij) * e2v(ii,ij) / e1v(ii,ij) 
     321               END DO 
     322            END DO 
     323 
     324            IF( lk_mpp )   CALL mpplnks( gcb )   !!bug ? should use an lbclnk ? is it possible??? 
     325 
     326         ELSE 
     327            ! north and south grid-points 
     328            DO jii = 1, 2 
     329               DO jnp = 1, mnisl(jii,jni) 
     330                  ii = miisl(jnp,jii,jni) 
     331                  ij = mjisl(jnp,jii,jni) 
     332                  IF( ( nperio == 3 .OR. nperio == 4 ) .AND. ( ij == jpj-1 .AND. jii == 1) ) THEN  
     333                     gcb(jpi-ii+1,ij-1) = gcb(jpi-ii+1,ij-1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij)  
     334                  ELSE   
     335                     gcb(ii,ij-jii+1) =  gcb(ii,ij-jii+1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 
    355336                  ENDIF 
    356                ENDIF 
    357             END DO 
    358          END DO 
    359          
    360 #    endif 
     337               END DO 
     338            END DO 
     339 
     340            ! east and west grid-points 
     341            DO jii = 3, 4 
     342               DO jnp = 1, mnisl(jii,jni) 
     343                  ii = miisl(jnp,jii,jni) 
     344                  ij = mjisl(jnp,jii,jni) 
     345                  IF( bmask(ii-jii+3,ij) /= 0. ) THEN 
     346                     gcb(ii-jii+3,ij) = gcb(ii-jii+3,ij) + hvr(ii,ij) * e2v(ii,ij) / e1v(ii,ij) 
     347                  ELSE 
     348                     ! east-west cyclic boundary conditions 
     349                     IF( ii-jii+3 == 1 ) THEN 
     350                        gcb(jpim1,ij) = gcb(jpim1,ij) + hvr(ii,ij) * e2v(ii,ij) / e1v(ii,ij) 
     351                     ENDIF 
     352                  ENDIF 
     353               END DO 
     354            END DO 
     355         ENDIF 
    361356 
    362357         ! 1.4 Preconditioned right hand side and absolute precision 
    … …  
    388383               END DO 
    389384            END DO 
    390 #if defined key_mpp 
    391             CALL mpp_sum( rnorme ) 
    392 #endif 
     385            IF( lk_mpp )   CALL mpp_sum( rnorme )   ! sum over the global domain 
     386 
    393387            IF(lwp) WRITE(numout,*) 'rnorme ', rnorme 
    394388            epsr = epsisl * epsisl * rnorme 
    … …  
    451445            END DO 
    452446         ENDIF 
    453 #if defined key_mpp 
    454          CALL lbc_lnk( bsfisl(:,:,jni), 'G', 1. ) 
    455 #endif 
     447         IF( lk_mpp )   CALL lbc_lnk( bsfisl(:,:,jni), 'G', 1. )   ! link at G-point 
    456448          
    457449          

  • trunk/NEMO/OPA_SRC/SOL/solmat.F90

    r3 r16  
    1818   USE obc_oce         ! ocean open boundary conditions 
    1919   USE lib_mpp         ! distributed memory computing 
     20   USE dynspg_rl 
     21   USE dynspg_fsc 
    2022 
    2123   IMPLICIT NONE 
    … …  
    3840      !! 
    3941      !! ** Method  :   The matrix depends on the type of free surface: 
    40       !!       * default option: rigid lid and bsf 
     42      !!       * lk_dynspg_rl=T: rigid lid formulation 
    4143      !!      The matrix is built for the barotropic stream function system. 
    4244      !!      a diagonal preconditioning matrix is also defined. 
    43       !!       * 'key_dynspg_fsc' defined: free surface 
     45      !!       * lk_dynspg_fsc=T: free surface formulation 
    4446      !!      The matrix is built for the divergence of the transport system 
    4547      !!      a diagonal preconditioning matrix is also defined. 
    … …  
    6769      INTEGER ::   ii, ij, iiend, ijend      ! temporary integers 
    6870      REAL(wp) ::   zcoefs, zcoefw, zcoefe, zcoefn  ! temporary scalars 
    69       REAL(wp) ::   z2dt 
    70 #if defined key_dynspg_fsc 
    71       REAL(wp) ::   zcoef 
    72 #endif 
     71      REAL(wp) ::   z2dt, zcoef 
    7372      !!---------------------------------------------------------------------- 
    7473 
    … …  
    8382       
    8483      ! initialize to zero 
     84      zcoef = 0.e0 
    8585      gcp(:,:,1) = 0.e0 
    8686      gcp(:,:,2) = 0.e0 
    … …  
    9494 
    9595#if defined key_dynspg_fsc && ! defined key_obc 
     96!!cr      IF( lk_dynspg_fsc .AND. .NOT.lk_obc ) THEN 
    9697 
    9798      ! defined the coefficients for free surface elliptic system 
    … …  
    99100      DO jj = 2, jpjm1 
    100101         DO ji = 2, jpim1 
    101             zcoef = z2dt * z2dt * g * rnu * bmask(ji,jj) 
     102            zcoef = z2dt * z2dt * grav * rnu * bmask(ji,jj) 
    102103            zcoefs = -zcoef * hv(ji  ,jj-1) * e1v(ji  ,jj-1) / e2v(ji  ,jj-1)    ! south coefficient 
    103104            zcoefw = -zcoef * hu(ji-1,jj  ) * e2u(ji-1,jj  ) / e1u(ji-1,jj  )    ! west coefficient 
    … …  
    109110            gcp(ji,jj,4) = zcoefn 
    110111            gcdmat(ji,jj) = e1t(ji,jj) * e2t(ji,jj) * bmask(ji,jj)    &          ! diagonal coefficient 
    111                           - zcoefs -zcoefw -zcoefe -zcoefn 
     112               &          - zcoefs -zcoefw -zcoefe -zcoefn 
    112113         END DO 
    113114      END DO 
    114115       
    115116#  elif defined key_dynspg_fsc && defined key_obc 
     117!!cr      ELSEIF( lk_dynspg_fsc .AND. lk_obc ) THEN 
    116118 
    117119      !   defined gcdmat in the case of open boundaries 
    … …  
    119121      DO jj = 2, jpjm1 
    120122         DO ji = 2, jpim1 
    121             zcoef = z2dt * z2dt * g * rnu * bmask(ji,jj) 
     123            zcoef = z2dt * z2dt * grav * rnu * bmask(ji,jj) 
    122124            !  south coefficient 
    123125            IF( ( lpsouthobc ) .AND. ( jj == njs0p1 ) ) THEN 
    … …  
    159161 
    160162#  else 
     163!!cr      ELSE 
    161164 
    162165      !   defined the coefficients for bsf elliptic system 
    … …  
    173176            gcp(ji,jj,4) = zcoefn 
    174177            gcdmat(ji,jj) = -zcoefs -zcoefw -zcoefe -zcoefn                             ! diagonal coefficient 
    175              
    176178         END DO 
    177179      END DO 
    178180       
     181!!cr  ENDIF 
    179182#endif 
    180183 
    … …  
    194197      ! account for the existence of the south symmetric bassin. 
    195198       
     199!!cr      IF( .NOT.lk_dynspg_fsc ) THEN 
    196200#if ! defined key_dynspg_fsc 
    197201      IF( nperio == 2 ) THEN 
    … …  
    203207         END DO 
    204208      ENDIF 
     209!!cr      ENDIF 
    205210#endif 
    206211       
    … …  
    225230         gcp(:,:,3) = gcp(:,:,3) * gcdprc(:,:) 
    226231         gcp(:,:,4) = gcp(:,:,4) * gcdprc(:,:) 
     232         IF( nsolv == 2 )   gccd(:,:) = sor * gcp(:,:,2) 
    227233 
    228234      ELSE 
    … …  
    467473      nnitot = nni 
    468474 
    469       CALL mpp_sum(nnitot,1,numit0ete) 
     475      CALL mpp_sum( nnitot, 1, numit0ete ) 
    470476      CALL feti_creadr(malxm,malxmax,nxm,npe*npe,maae,'ae') 
    471477 

  • trunk/NEMO/OPA_SRC/SOL/solpcg.F90

    r3 r16  
    1414   USE lib_mpp         ! distributed memory computing 
    1515   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     16   USE in_out_manager  ! I/O manager 
    1617 
    1718   IMPLICIT NONE 
    … …  
    3233      !!                     
    3334      !! ** Purpose :   Solve the ellipic equation for the barotropic stream  
    34       !!      function system (default option) or the transport divergence  
    35       !!      system ("key_dynspg_fsc") using a diagonal preconditionned 
     35      !!      function system (lk_dynspg_rl=T) or the transport divergence  
     36      !!      system (lk_dynspg_fsc=T) using a diagonal preconditionned 
    3637      !!      conjugate gradient method. 
    3738      !!      In the former case, the barotropic stream function trend has a 
    … …  
    9394         !                                             !================ 
    9495 
    95          !,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    96           
    97          IF( jn == 1 ) THEN 
    98              
    99             ! 1.0 Initialization of the algorithm 
    100             ! ----------------------------------- 
    101              
    102 #if defined key_dynspg_fsc 
    103 #   if defined key_mpp 
    104             ! Mpp: export boundary values to neighbouring processors 
    105             CALL lbc_lnk( gcx, 'S', 1. ) 
    106 #   else 
    107             !   mono- or macro-tasking: W-point, >0, 2D array, no slab 
    108             CALL lbc_lnk( gcx, 'T', 1. ) 
    109 #   endif 
    110 #else 
    111 #   if defined key_mpp 
    112             ! ... Mpp: export boundary values to neighbouring processors 
    113             CALL lbc_lnk( gcx, 'G', 1. ) 
    114 #   else 
    115             !   ... mono- or macro-tasking: F-point, >0, 2D array, no slab 
    116             CALL lbc_lnk( gcx, 'F', 1. ) 
    117 #   endif 
    118 #endif 
     96         IF( jn == 1 ) THEN           ! Initialization of the algorithm 
    11997 
    120             !,,,,,,,,,,,,,,,,,,,,,,,,synchro ,,,,,,,,,,,,,,,,,,,,,,, 
    121              
     98            CALL lbc_lnk( gcx, c_solver_pt, 1. )   ! lateral boundary condition 
     99 
    122100            ! gcr   = gcb-a.gcx 
    123101            ! gcdes = gsr 
    124              
    125102            DO jj = 2, jpjm1 
    126103               DO ji = fs_2, fs_jpim1   ! vector opt. 
    127                   zgcad = bmask(ji,jj)*(                         & 
    128                     gcb(ji,jj  ) -              gcx(ji  ,jj  )   & 
    129                                  - gcp(ji,jj,1)*gcx(ji  ,jj-1)   & 
    130                                  - gcp(ji,jj,2)*gcx(ji-1,jj  )   & 
    131                                  - gcp(ji,jj,3)*gcx(ji+1,jj  )   & 
    132                                  - gcp(ji,jj,4)*gcx(ji  ,jj+1)   ) 
     104                  zgcad = bmask(ji,jj) * ( gcb(ji,jj  ) -                gcx(ji  ,jj  )   & 
     105                     &                                  - gcp(ji,jj,1) * gcx(ji  ,jj-1)   & 
     106                     &                                  - gcp(ji,jj,2) * gcx(ji-1,jj  )   & 
     107                     &                                  - gcp(ji,jj,3) * gcx(ji+1,jj  )   & 
     108                     &                                  - gcp(ji,jj,4) * gcx(ji  ,jj+1)   ) 
    133109                  gcr  (ji,jj) = zgcad 
    134110                  gcdes(ji,jj) = zgcad 
    … …  
    136112            END DO 
    137113             
    138             !,,,,,,,,,,,,,,,,,,,,,,,,synchro ,,,,,,,,,,,,,,,,,,,,,,, 
    139              
    140114            rnorme = SUM(  gcr(:,:) * gcdmat(:,:) * gcr(:,:)  ) 
    141  
    142 #if defined key_mpp 
    143             ! Mpp: sum over all the global domain 
    144             CALL mpp_sum( rnorme ) 
    145 #endif 
     115            IF( lk_mpp )   CALL mpp_sum( rnorme )   ! sum over the global domain 
    146116            rr = rnorme 
    147117 
    148         ENDIF 
    149         !,,,,,,,,,,,,,,,,,,,,,,,,synchro ,,,,,,,,,,,,,,,,,,,,,,, 
     118         ENDIF 
    150119         
     120         !                             ! Algorithm 
    151121         
    152         ! 1.1 Algorithm 
    153         ! ------------- 
     122         CALL lbc_lnk( gcdes, c_solver_pt, 1. )   ! lateral boundary condition 
    154123         
    155         ! boundary condition on gcdes (only cyclic bc are required) 
    156 #if defined key_dynspg_fsc 
    157 #   if defined key_mpp 
    158         !   Mpp: export boundary values to neighbouring processors 
    159         CALL lbc_lnk( gcdes, 'S', 1. ) 
    160 #   else 
    161         !   mono- or macro-tasking: W-point, >0, 2D array, no slab 
    162         CALL lbc_lnk( gcdes, 'T', 1. ) 
    163 #   endif 
    164 #else 
    165 #   if defined key_mpp 
    166         !   Mpp: export boundary values to neighbouring processors 
    167         CALL lbc_lnk( gcdes, 'G', 1. ) 
    168 #   else 
    169         !   mono- or macro-tasking: F-point, >0, 2D array, no slab 
    170         CALL lbc_lnk( gcdes, 'F', 1. ) 
    171 #   endif 
    172 #endif 
     124         ! ... gccd = matrix . gcdes 
     125         DO jj = 2, jpjm1 
     126            DO ji = fs_2, fs_jpim1   ! vector opt. 
     127               gccd(ji,jj) = bmask(ji,jj)*( gcdes(ji,jj)   & 
     128                  &        +gcp(ji,jj,1)*gcdes(ji,jj-1)+gcp(ji,jj,2)*gcdes(ji-1,jj)   & 
     129                  &        +gcp(ji,jj,4)*gcdes(ji,jj+1)+gcp(ji,jj,3)*gcdes(ji+1,jj)   ) 
     130            END DO 
     131         END DO 
     132  
     133         ! alph = (gcr,gcr)/(gcdes,gccd) 
     134         radd = SUM(  gcdes(:,:) * gcdmat(:,:) * gccd(:,:)  ) 
     135         IF( lk_mpp )   CALL mpp_sum( radd )   ! sum over the global domain 
     136         alph = rr / radd 
     137          
     138         ! gcx = gcx + alph * gcdes 
     139         ! gcr = gcr - alph * gccd 
     140         DO jj = 2, jpjm1 
     141            DO ji = fs_2, fs_jpim1   ! vector opt. 
     142               gcx(ji,jj) = bmask(ji,jj) * ( gcx(ji,jj) + alph * gcdes(ji,jj) ) 
     143               gcr(ji,jj) = bmask(ji,jj) * ( gcr(ji,jj) - alph * gccd (ji,jj) ) 
     144            END DO 
     145         END DO 
    173146         
    174         !,,,,,,,,,,,,,,,,,,,,,,,,synchro if macrotasking,,,,,,,,,,,,,,,,,,,,,,, 
     147         ! rnorme = (gcr,gcr) 
     148         rnorme = SUM(  gcr(:,:) * gcdmat(:,:) * gcr(:,:)  ) 
     149         IF( lk_mpp )   CALL  mpp_sum( rnorme )   ! sum over the global domain 
    175150         
    176         ! ... gccd = matrix . gcdes 
    177         DO jj = 2, jpjm1 
    178            DO ji = fs_2, fs_jpim1   ! vector opt. 
    179               gccd(ji,jj) = bmask(ji,jj)*(   & 
    180                  gcdes(ji,jj)   & 
    181                 +gcp(ji,jj,1)*gcdes(ji,jj-1)+gcp(ji,jj,2)*gcdes(ji-1,jj)   & 
    182                 +gcp(ji,jj,4)*gcdes(ji,jj+1)+gcp(ji,jj,3)*gcdes(ji+1,jj)   & 
    183                 ) 
    184            END DO 
    185         END DO 
     151         ! test of convergence 
     152         IF( rnorme < epsr .OR. jn == nmax ) THEN 
     153            res = SQRT( rnorme ) 
     154            niter = jn 
     155            ncut = 999 
     156         ENDIF 
     157         
     158         ! beta = (rk+1,rk+1)/(rk,rk) 
     159         beta = rnorme / rr 
     160         rr   = rnorme 
    186161 
    187         !,,,,,,,,,,,,,,,,,,,,,,,,synchro if macrotasking,,,,,,,,,,,,,,,,,,,,,,, 
     162         ! indicator of non-convergence or explosion 
     163         IF( jn == nmax .OR. SQRT(epsr)/eps > 1.e+20 ) kindic = -2 
     164         IF( ncut == 999 ) GOTO 999 
     165 
     166         ! gcdes = gcr + beta * gcdes 
     167         DO jj = 2, jpjm1 
     168            DO ji = fs_2, fs_jpim1   ! vector opt. 
     169               gcdes(ji,jj) = bmask(ji,jj)*( gcr(ji,jj) + beta * gcdes(ji,jj) ) 
     170            END DO 
     171         END DO 
    188172         
    189         ! alph = (gcr,gcr)/(gcdes,gccd) 
    190  
    191         radd = SUM(  gcdes(:,:) * gcdmat(:,:) * gccd(:,:)  ) 
    192  
    193 #if defined key_mpp 
    194         ! Mpp: sum over all the global domain 
    195         CALL mpp_sum( radd ) 
    196 #endif 
    197         alph = rr / radd 
    198          
    199         !,,,,,,,,,,,,,,,,,,,,,,,,synchro if macrotasking,,,,,,,,,,,,,,,,,,,,,,, 
    200          
    201         ! gcx = gcx + alph * gcdes 
    202         ! gcr = gcr - alph * gccd 
    203         DO jj = 2, jpjm1 
    204            DO ji = fs_2, fs_jpim1   ! vector opt. 
    205               gcx(ji,jj) = bmask(ji,jj) * ( gcx(ji,jj) + alph * gcdes(ji,jj) ) 
    206               gcr(ji,jj) = bmask(ji,jj) * ( gcr(ji,jj) - alph * gccd (ji,jj) ) 
    207            END DO 
    208         END DO 
    209          
    210         !,,,,,,,,,,,,,,,,,,,,,,,,synchro if macrotasking,,,,,,,,,,,,,,,,,,,,,,, 
    211          
    212         ! rnorme = (gcr,gcr) 
    213  
    214         rnorme = SUM(  gcr(:,:) * gcdmat(:,:) * gcr(:,:)  ) 
    215  
    216 #if defined key_mpp 
    217         ! Mpp: sum over all the global domain 
    218         CALL  mpp_sum( rnorme ) 
    219 #endif 
    220          
    221         ! test of convergence 
    222         IF ( rnorme < epsr .OR. jn == nmax ) THEN 
    223            res = SQRT( rnorme ) 
    224            niter = jn 
    225            ncut = 999 
    226         ENDIF 
    227          
    228         ! beta = (rk+1,rk+1)/(rk,rk) 
    229         beta = rnorme / rr 
    230         rr   = rnorme 
    231  
    232         !,,,,,,,,,,,,,,,,,,,,,,,,synchro if macrotasking,,,,,,,,,,,,,,,,,,,,,,, 
    233  
    234         ! indicator of non-convergence or explosion 
    235         IF( jn == nmax .OR. sqrt(epsr)/eps > 1.e+20 ) kindic = -2 
    236         IF( ncut == 999 ) GOTO 999 
    237  
    238         ! gcdes = gcr + beta * gcdes 
    239         DO jj = 2, jpjm1 
    240            DO ji = fs_2, fs_jpim1   ! vector opt. 
    241               gcdes(ji,jj) = bmask(ji,jj)*( gcr(ji,jj) + beta * gcdes(ji,jj) ) 
    242            END DO 
    243         END DO 
    244          
    245         !                                             !================ 
    246      END DO                                           !    End Loop 
    247      !                                                !================ 
     173         !                                             !================ 
     174      END DO                                           !    End Loop 
     175      !                                                !================ 
    248176      
    249 999  CONTINUE 
     177999   CONTINUE 
    250178      
    251179      
    252      !  2. Output in gcx with lateral b.c. applied 
    253      !  ------------------------------------------ 
     180      ! Output in gcx with lateral b.c. applied 
     181      ! --------------------------------------- 
    254182      
    255      ! boundary conditions   !!bug ??? 
    256 #if defined key_mpp 
    257      ! Mpp: export boundary values to neighbouring processors 
    258 # if defined key_dynspg_fsc 
    259      CALL lbc_lnk( gcx, 'S', 1. ) 
    260 # else 
    261      CALL lbc_lnk( gcx, 'G', 1. ) 
    262 # endif 
    263 #else 
    264      IF ( nperio /= 0 ) THEN 
    265 # if defined key_dynspg_fsc 
    266         ! mono- or macro-tasking: W-point, >0, 2D array, no slab 
    267         CALL lbc_lnk( gcx, 'T', 1. ) 
    268 # else 
    269         ! mono- or macro-tasking: F-point, >0, 2D array, no slab 
    270         CALL lbc_lnk( gcx, 'F', 1. ) 
    271 # endif 
    272      ENDIF 
    273 #endif 
     183      CALL lbc_lnk( gcx, c_solver_pt, 1. ) 
    274184      
    275185   END SUBROUTINE sol_pcg 

  • trunk/NEMO/OPA_SRC/SOL/solsor.F90

    r3 r16  
    2222   !! * Routine accessibility 
    2323   PUBLIC sol_sor              ! ??? 
     24 
    2425   !!---------------------------------------------------------------------- 
    2526   !!   OPA 9.0 , LODYC-IPSL  (2003) 
    … …  
    2829CONTAINS 
    2930       
    30    SUBROUTINE sol_sor( kt, kindic ) 
     31   SUBROUTINE sol_sor( kindic ) 
    3132      !!---------------------------------------------------------------------- 
    3233      !!                  ***  ROUTINE sol_sor  *** 
    3334      !!                  
    3435      !! ** Purpose :   Solve the ellipic equation for the barotropic stream  
    35       !!      function system (default option) or the transport divergence  
    36       !!      system (key_dynspg_fsc = T) using a successive-over-relaxation 
     36      !!      function system (lk_dynspg_rl=T) or the transport divergence  
     37      !!      system (lk_dynspg_fsc=T) using a successive-over-relaxation 
    3738      !!      method. 
    3839      !!       In the former case, the barotropic stream function trend has a 
    … …  
    5960      !!---------------------------------------------------------------------- 
    6061      !! * Arguments 
    61       INTEGER, INTENT(  in   ) ::   kt       ! ocean time-step 
    6262      INTEGER, INTENT( inout ) ::   kindic   ! solver indicator, < 0 if the conver- 
    6363      !                                      ! gence is not reached: the model is 
    … …  
    6767      !! * Local declarations 
    6868      INTEGER  ::   ji, jj, jn               ! dummy loop indices 
    69       REAL(wp) ::   zgwgt                    ! temporary scalar 
    7069      !!---------------------------------------------------------------------- 
    7170       
    72        
    73       ! Iterative loop  
    74       ! ============== 
    75        
    76       IF( kt == nit000 )  gccd(:,:) = sor * gcp(:,:,2) 
     71      !                                                       ! ============== 
     72      DO jn = 1, nmax                                         ! Iterative loop  
     73         !                                                    ! ============== 
    7774 
    78  
    79       DO jn = 1, nmax 
    80  
    81          !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
     75         CALL lbc_lnk( gcx, c_solver_pt, 1. )   ! applied the lateral boubary conditions 
    8276          
    83          ! boundary conditions (at each sor iteration) only cyclic b. c. are required 
    84 #if defined key_dynspg_fsc 
    85 # if defined key_mpp 
    86             ! Mpp: export boundary values to neighbouring processors 
    87             CALL lbc_lnk( gcx, 'S', 1. )   ! S=T with special staff ??? 
    88 # else 
    89             CALL lbc_lnk( gcx, 'T', 1. ) 
    90 # endif 
    91 #else 
    92 # if defined key_mpp 
    93             ! Mpp: export boundary values to neighbouring processors 
    94             CALL lbc_lnk( gcx, 'G', 1. )   ! G= F with special staff ??? 
    95 # else 
    96             CALL lbc_lnk( gcx, 'F', 1. ) 
    97 # endif 
    98 #endif 
    99           
    100          !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    101           
    102          ! 1. Residus 
    103          ! ---------- 
    104   
     77         ! Residus 
     78         ! ------- 
    10579         DO jj = 2, jpjm1 
    10680            DO ji = 2, jpim1 
    107                gcr(ji,jj) =  gcb(ji,jj  ) -             gcx(ji  ,jj  )   & 
    108                                           -gcp(ji,jj,1)*gcx(ji  ,jj-1)   & 
    109                                           -gcp(ji,jj,2)*gcx(ji-1,jj  )   & 
    110                                           -gcp(ji,jj,3)*gcx(ji+1,jj  )   & 
    111                                           -gcp(ji,jj,4)*gcx(ji  ,jj+1) 
     81               gcr(ji,jj) =  gcb(ji,jj  ) -                gcx(ji  ,jj  )   & 
     82                                          - gcp(ji,jj,1) * gcx(ji  ,jj-1)   & 
     83                                          - gcp(ji,jj,2) * gcx(ji-1,jj  )   & 
     84                                          - gcp(ji,jj,3) * gcx(ji+1,jj  )   & 
     85                                          - gcp(ji,jj,4) * gcx(ji  ,jj+1) 
    11286            END DO 
    11387         END DO 
     88         CALL lbc_lnk( gcr, c_solver_pt, 1. )   ! applied the lateral boubary conditions 
    11489 
    115          !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    116           
    117          ! 1.1 Boundary conditions (at each sor iteration) only cyclic b. c. are required 
    118 #if defined key_dynspg_fsc 
    119 #   if defined key_mpp 
    120             ! Mpp: export boundary values to neighbouring processors 
    121             CALL lbc_lnk( gcr, 'S', 1. ) 
    122 #   else 
    123             ! mono- or macro-tasking: W-point, >0, 2D array, no slab 
    124             CALL lbc_lnk( gcr, 'T', 1. ) 
    125 #   endif 
    126 #else 
    127 #   if defined key_mpp 
    128             ! Mpp: export boundary values to neighbouring processors 
    129             CALL lbc_lnk( gcr, 'G', 1. ) 
    130 #   else 
    131             ! mono- or macro-tasking: W-point, >0, 2D array, no slab 
    132             CALL lbc_lnk( gcr, 'F', 1. ) 
    133 #   endif 
    134 #endif 
    135  
    136          ! 1.2 Successive over relaxation 
    137           
     90         ! Successive over relaxation 
    13891         DO jj = 2, jpj 
    13992            DO ji = 1, jpi 
    140                gcr(ji,jj) = gcr(ji,jj) - sor*gcp(ji,jj,1)*gcr(ji,jj-1) 
     93               gcr(ji,jj) = gcr(ji,jj) - sor * gcp(ji,jj,1) * gcr(ji,jj-1) 
    14194            END DO 
    14295            DO ji = 2, jpi 
    143                gcr(ji,jj) = gcr(ji,jj) - sor*gcp(ji,jj,2)*gcr(ji-1,jj) 
     96               gcr(ji,jj) = gcr(ji,jj) - sor * gcp(ji,jj,2) * gcr(ji-1,jj) 
    14497            END DO 
    14598         END DO 
    14699          
    147          !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    148           
    149100         ! gcx guess 
    150           
    151101         DO jj = 2, jpjm1 
    152102            DO ji = 1, jpi 
    153                gcx(ji,jj)  = (gcx(ji,jj)+sor*gcr(ji,jj))*bmask(ji,jj) 
     103               gcx(ji,jj)  = ( gcx(ji,jj) + sor * gcr(ji,jj) ) * bmask(ji,jj) 
    154104            END DO 
    155105         END DO 
    156           
    157          !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    158           
    159          ! boundary conditions (at each sor iteration) only cyclic b. c. are required 
    160 #if defined key_dynspg_fsc 
    161 #   if defined key_mpp 
    162          ! Mpp: export boundary values to neighbouring processors 
    163          CALL lbc_lnk( gcx, 'S', 1. ) 
    164 #   else 
    165          ! mono- or macro-tasking: W-point, >0, 2D array, no slab 
    166          CALL lbc_lnk( gcx, 'T', 1. ) 
    167 #   endif 
    168 #else 
    169 #   if defined key_mpp 
    170          ! Mpp: export boundary values to neighbouring processors 
    171          CALL lbc_lnk( gcx, 'G', 1. ) 
    172 #   else 
    173          ! mono- or macro-tasking: W-point, >0, 2D array, no slab 
    174          CALL lbc_lnk( gcx, 'F', 1. ) 
    175 #   endif 
    176 #endif 
    177           
    178          ! maximal residu (old exit test on the maximum value of residus) 
    179          !  
    180          ! imax = isamax( jpi*jpj, gcr, 1 ) 
    181           
    182          ! avoid an out of bound in no bounds compilation 
    183           
    184          ! iimax1 = mod( imax, jpi ) 
    185          ! ijmax1 = int( float(imax) / float(jpi)) + 1 
    186          ! resmax = abs( gcr(iimax1,ijmax1) ) 
     106         CALL lbc_lnk( gcx, c_solver_pt, 1. ) 
    187107          
    188108         ! relative precision 
    189           
    190          rnorme = 0. 
    191          DO jj = 1, jpj 
    192             DO ji = 1, jpi 
    193                zgwgt = gcdmat(ji,jj) * gcr(ji,jj) 
    194                rnorme= rnorme + gcr(ji,jj)*zgwgt 
    195             END DO 
    196          END DO 
    197           
    198 #if defined key_mpp 
    199          ! mpp sum over all the global domain 
    200          CALL  mpp_sum( rnorme ) 
    201 #endif 
     109         rnorme = SUM( gcr(:,:) * gcdmat(:,:) * gcr(:,:) ) 
     110         IF( lk_mpp )   CALL mpp_sum( rnorme )   ! sum over the global domain 
    202111          
    203112         ! test of convergence 
    … …  
    216125         !**** 
    217126          
    218          !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    219           
    220127         ! indicator of non-convergence or explosion 
    221           
    222128         IF( jn == nmax .OR. SQRT(epsr)/eps > 1.e+20 ) kindic = -2 
    223129         IF( ncut == 999 ) GOTO 999 
    224130          
    225           
    226          ! END of iterative loop 
    227          ! ===================== 
    228           
    229       END DO 
    230        
     131         !                                                 ! ===================== 
     132      END DO                                               ! END of iterative loop 
     133      !                                                    ! ===================== 
    231134       
    232135999   CONTINUE 
    233136       
    234137       
    235       !  2. Output in gcx 
    236       !  ----------------- 
     138      !  Output in gcx 
     139      !  ------------- 
    237140       
    238       ! boundary conditions (est-ce necessaire? je ne crois pas!!!!) 
    239        
    240 #if defined key_dynspg_fsc 
    241 # if defined key_mpp 
    242       ! Mpp: export boundary values to neighbouring processors 
    243       CALL lbc_lnk( gcx, 'S', 1. ) 
    244 # else 
    245       IF( nperio /= 0 ) THEN 
    246          CALL lbc_lnk( gcx, 'T', 1. ) 
    247       ENDIF 
    248 # endif 
    249 #else 
    250 # if defined key_mpp 
    251       ! Mpp: export boundary values to neighbouring processors 
    252       CALL lbc_lnk( gcx, 'G', 1. ) 
    253 # else 
    254       IF( nperio /= 0 ) THEN 
    255          CALL lbc_lnk( gcx, 'F', 1. ) 
    256       ENDIF 
    257 # endif 
    258 #endif 
     141      CALL lbc_lnk( gcx, c_solver_pt, 1. )    ! boundary conditions (est-ce necessaire? je ne crois pas!!!!) 
    259142       
    260143   END SUBROUTINE sol_sor 

  • trunk/NEMO/OPA_SRC/SOL/solver.F90

    r3 r16  
    1818   USE in_out_manager  ! I/O manager 
    1919   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     20   USE lib_mpp 
     21   USE dynspg_rl        
     22   USE dynspg_fsc       
    2023 
    2124   IMPLICIT NONE 
    … …  
    3437      !!       * default option: barotropic stream function system 
    3538      !!         and islands initialization (if l_isl=T) 
    36       !!       * key_dynspg_fsc = T : transport divergence system. No specific 
     39      !!       * lk_dynspg_fsc = T : transport divergence system. No specific 
    3740      !!         treatment of islands. 
    3841      !!       
    3942      !! ** Method : 
    4043      !!       - Compute the local depth of the water column at u- and v-point 
    41       !!      (key_dynspg_fsc = T) or its inverse (key_dynspg_rl = T). 
     44      !!      (lk_dynspg_fsc = T) or its inverse (lk_dynspg_rl = T). 
    4245      !!      The local depth of the water column is computed by summing  
    4346      !!      the vertical scale factors. For its inverse, the thickness of 
    … …  
    5659      !! 
    5760      !! ** Action : - hur, hvr : masked inverse of the local depth at 
    58       !!                                u- and v-point. (key_dynspg_rl = T) 
     61      !!                                u- and v-point. (lk_dynspg_rl = T) 
    5962      !!             - hu, hv   : masked local depth at u- and v- points 
    60       !!                                (key_dynspg_fsc = T) 
     63      !!                                (lk_dynspg_fsc = T) 
     64      !!             - c_solver_pt : nature of the gridpoint at which the 
     65      !!                                solver is applied 
    6166      !! References : 
    6267      !!      Jensen, 1986: adv. phys. oceanogr. num. mod.,ed. o brien,87-110. 
    … …  
    115120      ENDIF 
    116121 
    117 #if defined key_dynspg_fsc  
     122      IF( lk_dynspg_fsc ) THEN 
    118123         IF(lwp) WRITE(numout,*) 
    119124         IF(lwp) WRITE(numout,*) '          *** free surface formulation' 
    … …  
    123128            nstop = nstop + 1 
    124129         ENDIF 
    125 #endif 
    126 #if defined key_dynspg_rl 
     130      ELSEIF( lk_dynspg_rl ) THEN 
    127131         IF(lwp) WRITE(numout,*) 
    128132         IF(lwp) WRITE(numout,*) '          *** Rigid lid formulation' 
    129 #endif 
    130 #if defined key_dynspg_fsc && defined key_dynspg_rl 
     133      ELSE 
     134         IF(lwp) WRITE(numout,cform_err) 
     135         IF(lwp) WRITE(numout,*) '          Chose at least one surface pressure gradient calculation: free surface or rigid-lid' 
     136         nstop = nstop + 1 
     137      ENDIF 
     138      IF( lk_dynspg_fsc .AND. lk_dynspg_rl ) THEN 
    131139         IF(lwp) WRITE(numout,cform_err) 
    132140         IF(lwp) WRITE(numout,*) '          Chose between free surface or rigid-lid, not both' 
    133141         nstop = nstop + 1 
    134 #endif 
     142      ENDIF 
    135143 
    136144      SELECT CASE ( nsolv ) 
    … …  
    144152      CASE ( 3 )                ! FETI solver 
    145153         IF(lwp) WRITE(numout,*) '          use the FETI solver' 
    146 #if ! defined key_mpp 
    147          IF(lwp) WRITE(numout,*) ' The FETI algorithm is used only with the key_mpp option' 
    148          nstop = nstop + 1 
    149 #else 
    150          IF( jpnij == 1 ) THEN 
    151             IF(lwp) WRITE(numout,*) ' The FETI algorithm needs more than one processor' 
     154         IF( .NOT.lk_mpp ) THEN 
     155            IF(lwp) WRITE(numout,*) ' The FETI algorithm is used only with the key_mpp_... option' 
    152156            nstop = nstop + 1 
    153          ENDIF 
    154 #endif 
     157         ELSE 
     158            IF( jpnij == 1 ) THEN 
     159               IF(lwp) WRITE(numout,*) ' The FETI algorithm needs more than one processor' 
     160               nstop = nstop + 1 
     161            ENDIF 
     162         ENDIF 
    155163          
    156164      CASE DEFAULT 
    … …  
    161169      END SELECT 
    162170 
     171      ! Grid-point at which the solver is applied 
     172      ! ----------------------------------------- 
     173 
     174      IF( lk_dynspg_rl ) THEN       ! rigid-lid 
     175         IF( lk_mpp ) THEN 
     176            c_solver_pt = 'G'   ! G= F with special staff ??? which one? 
     177         ELSE 
     178            c_solver_pt = 'F' 
     179         ENDIF 
     180      ELSE                          ! free surface T-point 
     181         IF( lk_mpp ) THEN 
     182            c_solver_pt = 'S'   ! S=T with special staff ??? which one? 
     183         ELSE 
     184            c_solver_pt = 'T' 
     185         ENDIF 
     186      ENDIF 
     187 
    163188 
    164189      ! Construction of the elliptic system matrix 

  • trunk/NEMO/OPA_SRC/TRD/trddyn.F90

    r3 r16  
    3434 
    3535   !! * Shared module vaiables 
    36    LOGICAL, PUBLIC, PARAMETER ::   lk_trddyn = .TRUE.   ! momentum trend flag 
     36   LOGICAL, PUBLIC, PARAMETER ::   lk_trddyn = .TRUE.    !: momentum trend flag 
    3737 
    3838   !! * Substitutions 
    … …  
    231231            DO ji = 1, jpi 
    232232               zhke(10) = zhke(10)   & 
    233                &   + ub(ji,jj,1) * tautrd(ji,jj,1) * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,1)   & 
    234                &   + vb(ji,jj,1) * tautrd(ji,jj,2) * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,1) 
     233                  &     + ub(ji,jj,1) * tautrd(ji,jj,1) * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,1)   & 
     234                  &     + vb(ji,jj,1) * tautrd(ji,jj,2) * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,1) 
    235235            END DO 
    236236         END DO 
    … …  
    240240            DO jj = 1, jpj 
    241241               DO ji = 1, jpi 
    242                   zpeke    = zpeke + zkepe(ji,jj,jk) * g * fsdept(ji,jj,jk)   & 
    243                   &                        * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
    244                END DO 
    245             END DO 
    246          END DO 
    247           
    248 # if defined key_mpp 
    249          CALL mpp_sum( zpeke ) 
    250          CALL mpp_sum( zumo , 11 ) 
    251          CALL mpp_sum( zvmo , 11 ) 
    252          CALL mpp_sum( zhke , 10 ) 
    253 # endif 
     242                  zpeke    = zpeke + zkepe(ji,jj,jk) * grav * fsdept(ji,jj,jk)   & 
     243                     &                     * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
     244               END DO 
     245            END DO 
     246         END DO 
     247          
     248         IF( lk_mpp ) THEN 
     249            CALL mpp_sum( zpeke ) 
     250            CALL mpp_sum( zumo , 11 ) 
     251            CALL mpp_sum( zvmo , 11 ) 
     252            CALL mpp_sum( zhke , 10 ) 
     253         ENDIF 
    254254 
    255255 
    … …  
    423423         END DO 
    424424      END DO 
    425 # if defined key_mpp 
    426       CALL mpp_sum( tvols ) 
    427       CALL mpp_sum( tvolu ) 
    428       CALL mpp_sum( tvolv ) 
    429 # endif 
     425      IF( lk_mpp )   CALL mpp_sum( tvols )   ! sums over the global domain 
     426      IF( lk_mpp )   CALL mpp_sum( tvolu ) 
     427      IF( lk_mpp )   CALL mpp_sum( tvolv ) 
    430428 
    431429      IF(lwp) THEN 
    … …  
    446444   !!   Default option :                      NO mementum trend diagnostics 
    447445   !!---------------------------------------------------------------------- 
    448    LOGICAL, PUBLIC, PARAMETER ::   lk_trddyn = .FALSE.   ! momentum trend flag 
     446   LOGICAL, PUBLIC, PARAMETER ::   lk_trddyn = .FALSE.   !: momentum trend flag 
    449447CONTAINS 
    450448   SUBROUTINE trd_dyn( kt )        ! Empty routine 
    451       WRITE(*,*) kt 
     449      WRITE(*,*) 'trd_dyn: You should not have seen this print! error?', kt 
    452450   END SUBROUTINE trd_dyn 
    453451   SUBROUTINE trd_dyn_init         ! Empty routine 

  • trunk/NEMO/OPA_SRC/TRD/trdmld.F90

    r3 r16  
    3737 
    3838   !! * Shared module variables 
    39    LOGICAL, PUBLIC, PARAMETER ::   lk_trdmld = .TRUE.   ! momentum trend flag 
     39   LOGICAL, PUBLIC, PARAMETER ::   lk_trdmld = .TRUE.    !: momentum trend flag 
    4040 
    4141   !! * Module variables 
    … …  
    609609   !!   Default option :                                       Empty module 
    610610   !!---------------------------------------------------------------------- 
    611    LOGICAL, PUBLIC, PARAMETER ::   lk_trdmld = .FALSE.   ! momentum trend flag 
     611   LOGICAL, PUBLIC, PARAMETER ::   lk_trdmld = .FALSE.   !: momentum trend flag 
    612612CONTAINS 
    613613   SUBROUTINE trd_mld( kt )        ! Empty routine 
    614       WRITE(*,*) kt 
     614      WRITE(*,*) 'trd_mld: You should not have seen this print! error?', kt 
    615615   END SUBROUTINE trd_mld 
    616616#endif 

  • trunk/NEMO/OPA_SRC/TRD/trdtra.F90

    r3 r16  
    3333 
    3434   !! * Shared module variables 
    35    LOGICAL, PUBLIC, PARAMETER ::   lk_trdtra = .TRUE.   ! momentum trend flag 
     35   LOGICAL, PUBLIC, PARAMETER ::   lk_trdtra = .TRUE.    !: momentum trend flag 
    3636 
    3737   !! * Substitutions 
    … …  
    9595            END DO 
    9696         END DO 
    97 #if defined key_mpp 
    98          CALL mpp_sum( tvolt ) 
    99 #endif 
     97         IF( lk_mpp )   CALL mpp_sum( tvolt )   ! sum over the global domain 
     98 
    10099         IF(lwp) THEN 
    101100            WRITE(numout,*) 
    … …  
    208207         END DO 
    209208          
    210 #if defined key_mpp 
    211          CALL mpp_sum( ztmo, 10 ) 
    212          CALL mpp_sum( zsmo, 10 ) 
    213          CALL mpp_sum( zt2 , 10 ) 
    214          CALL mpp_sum( zs2 , 10 ) 
    215 #endif 
     209         IF( lk_mpp ) THEN 
     210            CALL mpp_sum( ztmo, 10 )   ! sums over the global domain 
     211            CALL mpp_sum( zsmo, 10 ) 
     212            CALL mpp_sum( zt2 , 10 ) 
     213            CALL mpp_sum( zs2 , 10 ) 
     214         ENDIF 
    216215          
    217216         ! 4. Print 
    … …  
    358357         END DO 
    359358      END DO 
    360 #if defined key_mpp 
    361       CALL mpp_sum( tvolt ) 
    362 #endif 
    363       IF(lwp) THEN 
    364          WRITE(numout,*) '          total ocean volume at T-point   tvolt = ',tvolt 
    365       ENDIF 
     359      IF( lk_mpp )   CALL mpp_sum( tvolt )   ! sum over the global domain 
     360 
     361      IF(lwp) WRITE(numout,*) '          total ocean volume at T-point   tvolt = ',tvolt 
    366362 
    367363   END SUBROUTINE trd_tra_init 
    … …  
    371367   !!   Default case :                                         Empty module 
    372368   !!---------------------------------------------------------------------- 
    373    LOGICAL, PUBLIC, PARAMETER ::   lk_trdtra = .FALSE.   ! momentum trend flag 
     369   LOGICAL, PUBLIC, PARAMETER ::   lk_trdtra = .FALSE.   !: momentum trend flag 
    374370CONTAINS 
    375371   SUBROUTINE trd_tra( kt )        ! Empty routine 
    376       WRITE(*,*) kt 
     372      WRITE(*,*) 'trd_tra: You should not have seen this print! error?', kt 
    377373   END SUBROUTINE trd_tra 
    378374   SUBROUTINE trd_tra_init         ! Empty routine 

  • trunk/NEMO/OPA_SRC/TRD/trdtra_oce.F90

    r3 r16  
    1212   PUBLIC 
    1313 
    14    INTEGER  ::      & !!! namdia :  diagnostics on dynamics and/or tracer trends 
     14   INTEGER  ::      & !!: namdia :  diagnostics on dynamics and/or tracer trends 
    1515      ntrd  = 10 ,  &  !: time step frequency dynamics and tracers trends 
    1616      nctls =  0       !: control surface type for trends vertical integration 
    … …  
    2525   !! Trends diagnostics parameters 
    2626   !!--------------------------------------------------------------------- 
    27    INTEGER, PARAMETER ::            & 
     27   INTEGER, PARAMETER ::            &  !: 
    2828# if defined key_traldf_eiv 
    2929      jptrdh = 4,   &  !: number of 3D horiz trends arrays 
    … …  
    3838   !! Trends diagnostics variables 
    3939   !!--------------------------------------------------------------------- 
    40    REAL(wp) ::   & 
    41       tvolt         ! volume of the whole ocean computed at t-points 
    42    REAL(wp), DIMENSION(jpi,jpj,jpk,7) ::   & 
     40   REAL(wp) ::   &  !: 
     41      tvolt         !: volume of the whole ocean computed at t-points 
     42   REAL(wp), DIMENSION(jpi,jpj,jpk,7) ::   &  !: 
    4343      ttrd             !: trends of the temperature tracer equations 
    4444      !                !  ttrd(,,,1) : horizontal advection 
    … …  
    4949      !                !  ttrd(,,,6) : damping OR vertical EIV 
    5050      !                !  ttrd(,,,7) : penetrative solar radiation (T only) 
    51    REAL(wp), DIMENSION(jpi,jpj,jpk,6) ::   & 
     51   REAL(wp), DIMENSION(jpi,jpj,jpk,6) ::   &  !: 
    5252      strd             !: trends of the salinity tracer equations 
    5353      !                !  same as ttrd() 
    54    REAL(wp), DIMENSION(jpi,jpj,jpk,jptrdh) ::   & 
     54   REAL(wp), DIMENSION(jpi,jpj,jpk,jptrdh) ::   &  !: 
    5555      ttrdh, strdh     !: ttrdh(,,,1) : zonal advection 
    5656      !                !  ttrdh(,,,2) : meridional advection 
    5757      !                !  ttrdh(,,,3) : zonal EIV 
    5858      !                !  ttrdh(,,,4) : meridional EIV 
    59    REAL(wp), DIMENSION(jpi,jpj,2) ::   & 
     59   REAL(wp), DIMENSION(jpi,jpj,2) ::   &  !: 
    6060      flxtrd,       &  !: tracer forcing trends 
    6161      bbltrd           !: tracer bottom boundary layer trends 

  • trunk/NEMO/OPA_SRC/ZDF/zdf_oce.F90

    r3 r16  
    1515 
    1616   !! * Share Module variables 
    17    LOGICAL, PARAMETER, PUBLIC ::    & 
     17   LOGICAL, PARAMETER, PUBLIC ::    &   !: 
    1818#if defined key_zdfcst   ||   defined key_esopa 
    1919      lk_zdfcst        = .TRUE.         !: constant vertical mixing flag 
    … …  
    2121      lk_zdfcst        = .FALSE.        !: constant vertical mixing flag 
    2222#endif 
    23    LOGICAL, PUBLIC ::    & 
     23   LOGICAL, PUBLIC ::    &   !: 
    2424      ln_zdfevd        = .TRUE.  ,   &  !: convection: enhanced vertical diffusion flag 
    2525      ln_zdfnpc        = .FALSE.        !: convection: non-penetrative convection flag 
    2626 
    27    LOGICAL, PUBLIC ::    & 
     27   LOGICAL, PUBLIC ::    &   !: 
    2828      l_trazdf_exp     = .FALSE. ,   &  !: ??? 
    2929      l_trazdf_imp     = .FALSE. ,   &  !:  
    … …  
    3232      l_dynzdf_imp_tsk = .FALSE.        !: 
    3333 
    34    INTEGER, PUBLIC ::    & !!! namzdf:  vertical diffusion 
     34   INTEGER, PUBLIC ::    & !!: namzdf:  vertical diffusion 
    3535      n_zdfexp = 3    ,  &  !: number of sub-time step (explicit time stepping) 
    3636      nevdm    = 1          !: =0/1 flag to apply enhanced avm or not 
    3737  
    38    REAL(wp), PUBLIC ::   & !!! namzdf   vertical diffusion 
     38   REAL(wp), PUBLIC ::   & !!: namzdf   vertical diffusion 
    3939      avm0  = 1.e-4_wp,  &  !: vertical eddy viscosity (m2/s) 
    4040      avt0  = 1.e-5_wp,  &  !: vertical eddy diffusivity (m2/s) 
    4141      avevd = 1._wp         !: vertical eddy coeff. for enhanced vert. diff. (m2/s) 
    4242 
    43    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   & 
     43   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &   !: 
    4444      avmu,              &  !: vertical viscosity coeff. at uw-, vw-points 
    4545      avmv,              &  !: vertical viscosity coeff. at uw-, vw-points 
    4646      avt                   !: vertical diffusivity coeff. at w-point 
    4747  
    48    REAL(wp), PUBLIC, DIMENSION(jpk) ::   & 
     48   REAL(wp), PUBLIC, DIMENSION(jpk) ::   &   !: 
    4949      avmb, avtb            !: background profile of avm and avt 
    5050  

  • trunk/NEMO/OPA_SRC/ZDF/zdfddm.F90

    r3 r16  
    2525 
    2626   !! * Shared module variables 
    27    LOGICAL, PUBLIC ::   lk_zdfddm = .TRUE.    !: double diffusive mixing flag 
    28    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   & 
     27   LOGICAL, PUBLIC, PARAMETER ::   lk_zdfddm = .TRUE.    !: double diffusive mixing flag 
     28   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &   !: 
    2929      avs ,               &  !: salinity vertical diffusivity coeff. at w-point 
    3030      rrau                   !: heat/salt buoyancy flux ratio 
    … …  
    242242   !!   Default option :          Dummy module          No double diffusion 
    243243   !!---------------------------------------------------------------------- 
    244    LOGICAL, PUBLIC ::   lk_zdfddm = .FALSE.   !: double diffusion flag 
     244   LOGICAL, PUBLIC, PARAMETER ::   lk_zdfddm = .FALSE.   !: double diffusion flag 
    245245CONTAINS 
    246246   SUBROUTINE zdf_ddm( kt )           ! Dummy routine 
    247       WRITE(*,*) kt                          ! avoid compil warning 
     247      WRITE(*,*) 'zdf_ddm: You should not have seen this print! error?', kt 
    248248   END SUBROUTINE zdf_ddm 
    249249#endif 

  • trunk/NEMO/OPA_SRC/ZDF/zdfmxl.F90

    r3 r16  
    2121 
    2222   !! * Shared module variables 
    23    INTEGER, PUBLIC, DIMENSION(jpi,jpj) ::   & 
     23   INTEGER, PUBLIC, DIMENSION(jpi,jpj) ::   &   !: 
    2424      nmln                  !: number of level in the mixed layer 
    25    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   & 
     25   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &   !: 
    2626      hmld ,             &  !: mixing layer depth (turbocline) (m) 
    2727      hmlp ,             &  !: mixed layer depth  (rho=rho0+zdcrit) (m) 

  • trunk/NEMO/OPA_SRC/ZDF/zdfric.F90

    r3 r16  
    2828 
    2929   !! * Shared module variables 
    30    LOGICAL, PUBLIC, PARAMETER ::   lk_zdfric = .TRUE.   !: Richardson vertical mixing flag 
     30   LOGICAL, PUBLIC, PARAMETER ::   lk_zdfric = .TRUE.    !: Richardson vertical mixing flag 
    3131 
    3232   !! * Module variables 
    … …  
    256256CONTAINS 
    257257   SUBROUTINE zdf_ric( kt )        ! Dummy routine 
    258       WRITE(*,*) kt  
     258      WRITE(*,*) 'zdf_ric: You should not have seen this print! error?', kt 
    259259   END SUBROUTINE zdf_ric 
    260260#endif 

  • trunk/NEMO/OPA_SRC/ZDF/zdftke.F90

    r3 r16  
    2828 
    2929   !! * Share Module variables 
    30    LOGICAL, PUBLIC, PARAMETER ::   lk_zdftke = .TRUE.   !: TKE vertical mixing flag 
    31    LOGICAL, PUBLIC ::         & !!! ** tke namelist (namtke) ** 
     30   LOGICAL, PUBLIC, PARAMETER ::   lk_zdftke = .TRUE.    !: TKE vertical mixing flag 
     31   LOGICAL, PUBLIC ::         & !!: ** tke namelist (namtke) ** 
    3232     ln_rstke = .FALSE.          !: =T restart with tke from a run without tke with  
    3333     !                           !  a none zero initial value for en 
    34    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   & 
     34   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &   !: 
    3535      en                         !: now turbulent kinetic energy 
    3636 
    … …  
    9292      !!         d(en)/dt = eboost eav (d(u)/dz)**2       ! shear production 
    9393      !!                  + d( efave eav d(en)/dz )/dz    ! diffusion of tke 
    94       !!                  + g/rau0 pdl eav d(rau)/dz      ! stratif. destruc. 
     94      !!                  + grav/rau0 pdl eav d(rau)/dz   ! stratif. destruc. 
    9595      !!                  - ediss / emxl en**(2/3)        ! dissipation 
    9696      !!      with the boundary conditions: 
    … …  
    791791   !!   Dummy module :                                        NO TKE scheme 
    792792   !!---------------------------------------------------------------------- 
    793    LOGICAL, PUBLIC, PARAMETER ::   lk_zdftke = .FALSE.   ! TKE flag 
     793   LOGICAL, PUBLIC, PARAMETER ::   lk_zdftke = .FALSE.   !: TKE flag 
    794794CONTAINS 
    795795   SUBROUTINE zdf_tke( kt )          ! Empty routine 
    796       WRITE(*,*) kt                     ! no compilation warning 
     796      WRITE(*,*) 'zdf_tke: You should not have seen this print! error?', kt 
    797797   END SUBROUTINE zdf_tke 
    798798#endif 
Note: See TracChangeset for help on using the changeset viewer.