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 7277 for branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/SAO_SRC/nemogcm.F90 – NEMO

Ignore:
Timestamp:
2016-11-21T09:55:07+01:00 (8 years ago)
Author:
flavoni
Message:

update 2016 branch with simplif-2

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/SAO_SRC/nemogcm.F90

    r5600 r7277  
    44   !! Ocean system   : NEMO GCM (ocean dynamics, on-line tracers, biochemistry and sea-ice) 
    55   !!====================================================================== 
    6    !! History :  OPA  ! 1990-10  (C. Levy, G. Madec)  Original code 
    7    !!            7.0  ! 1991-11  (M. Imbard, C. Levy, G. Madec) 
    8    !!            7.1  ! 1993-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar, 
    9    !!                             P. Delecluse, C. Perigaud, G. Caniaux, B. Colot, C. Maes) release 7.1 
    10    !!             -   ! 1992-06  (L.Terray)  coupling implementation 
    11    !!             -   ! 1993-11  (M.A. Filiberti) IGLOO sea-ice 
    12    !!            8.0  ! 1996-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar, 
    13    !!                             P. Delecluse, L.Terray, M.A. Filiberti, J. Vialar, A.M. Treguier, M. Levy) release 8.0 
    14    !!            8.1  ! 1997-06  (M. Imbard, G. Madec) 
    15    !!            8.2  ! 1999-11  (M. Imbard, H. Goosse)  LIM sea-ice model 
    16    !!                 ! 1999-12  (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols)  OPEN-MP 
    17    !!                 ! 2000-07  (J-M Molines, M. Imbard)  Open Boundary Conditions  (CLIPPER) 
    18    !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90: Free form and modules 
    19    !!             -   ! 2004-06  (R. Redler, NEC CCRLE, Germany) add OASIS[3/4] coupled interfaces 
    20    !!             -   ! 2004-08  (C. Talandier) New trends organization 
    21    !!             -   ! 2005-06  (C. Ethe) Add the 1D configuration possibility 
    22    !!             -   ! 2005-11  (V. Garnier) Surface pressure gradient organization 
    23    !!             -   ! 2006-03  (L. Debreu, C. Mazauric)  Agrif implementation 
    24    !!             -   ! 2006-04  (G. Madec, R. Benshila)  Step reorganization 
    25    !!             -   ! 2007-07  (J. Chanut, A. Sellar) Unstructured open boundaries (BDY) 
    26    !!            3.2  ! 2009-08  (S. Masson)  open/write in the listing file in mpp 
    27    !!            3.3  ! 2010-05  (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface 
    28    !!             -   ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
    29    !!            3.3.1! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation 
    30    !!            3.4  ! 2011-11  (C. Harris) decomposition changes for running with CICE 
    31    !!                 ! 2012-05  (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening  
     6   !! History :  3.6  ! 2015-12  (A. Ryan) Original code   (from OPA_SRC/)  
     7   !!            4.0  ! 2016-11  (G. Madec, S. Flavoni)  domain configuration / user defined interface 
    328   !!---------------------------------------------------------------------- 
    339 
    3410   !!---------------------------------------------------------------------- 
    35    !!   nemo_gcm       : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice 
    36    !!   nemo_init      : initialization of the NEMO system 
    37    !!   nemo_ctl       : initialisation of the contol print 
    38    !!   nemo_closefile : close remaining open files 
    39    !!   nemo_alloc     : dynamical allocation 
    40    !!   nemo_partition : calculate MPP domain decomposition 
    41    !!   factorise      : calculate the factors of the no. of MPI processes 
     11   !!   nemo_gcm      : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice 
     12   !!   nemo_init     : initialization of the NEMO system 
     13   !!   nemo_ctl      : initialisation of the contol print 
     14   !!   nemo_closefile: close remaining open files 
     15   !!   nemo_alloc    : dynamical allocation 
     16   !!   nemo_partition: calculate MPP domain decomposition 
     17   !!   factorise     : calculate the factors of the no. of MPI processes 
    4218   !!---------------------------------------------------------------------- 
    43    USE step_oce        ! module used in the ocean time stepping module 
    44    USE domcfg          ! domain configuration               (dom_cfg routine) 
    45    USE mppini          ! shared/distributed memory setting (mpp_init routine) 
    46    USE domain          ! domain initialization             (dom_init routine) 
     19   USE step_oce       ! module used in the ocean time stepping module (step.F90) 
     20   USE domain         ! domain initialization   (dom_init & dom_cfg routines) 
     21   USE istate         ! initial state setting          (istate_init routine) 
     22   USE phycst         ! physical constant                  (par_cst routine) 
     23   USE step           ! NEMO time-stepping                 (stp     routine) 
     24   USE cpl_oasis3     ! OASIS3 coupling 
     25   USE diaobs         ! Observation diagnostics       (dia_obs_init routine) 
    4726#if defined key_nemocice_decomp 
    4827   USE ice_domain_size, only: nx_global, ny_global 
    4928#endif 
    50    USE istate          ! initial state setting          (istate_init routine) 
    51    USE phycst          ! physical constant                  (par_cst routine) 
    52    USE diaobs          ! Observation diagnostics       (dia_obs_init routine) 
    53    USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    54    USE step            ! NEMO time-stepping                 (stp     routine) 
    55    USE cpl_oasis3      ! OASIS3 coupling 
    56    USE lib_mpp         ! distributed memory computing 
    57 #if defined key_iomput 
    58    USE xios 
    59 #endif 
    60    USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges  
    61  
    62    ! Stand Alone Observation operator modules 
     29   !           ! Stand Alone Observation operator modules 
    6330   USE sao_data 
    6431   USE sao_intp 
     32   ! 
     33   USE lib_mpp        ! distributed memory computing 
     34   USE mppini         ! shared/distributed memory setting (mpp_init routine) 
     35   USE lbcnfd  , ONLY : isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges  
     36   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
     37#if defined key_iomput 
     38   USE xios           ! xIOserver 
     39#endif 
    6540 
    6641   IMPLICIT NONE 
     
    7449 
    7550   !!---------------------------------------------------------------------- 
    76    !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
     51   !! NEMO/OPA 4.0 , NEMO Consortium (2016) 
    7752   !! $Id$ 
    7853   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    9166         !!             3. Cycle through match ups 
    9267         !!             4. Write results to file 
    93          !! 
    9468         !!---------------------------------------------------------------------- 
    95          !! Initialise NEMO 
    96          CALL nemo_init 
    97          !! Initialise Stand Alone Observation operator data 
    98          CALL sao_data_init 
    99          !! Initialise obs_oper 
    100          CALL dia_obs_init 
    101          !! Interpolate to observation space 
    102          CALL sao_interp 
    103          !! Pipe to output files 
    104          CALL dia_obs_wri 
    105          !! Reset the obs_oper between 
    106          CALL dia_obs_dealloc 
    107          !! Safely stop MPI 
    108          IF(lk_mpp) CALL mppstop  ! end mpp communications 
     69         ! 
     70         CALL nemo_init       ! Initialise NEMO 
     71         ! 
     72         CALL sao_data_init   ! Initialise Stand Alone Observation operator data 
     73         ! 
     74         CALL dia_obs_init    ! Initialise obs_operator 
     75         ! 
     76         CALL sao_interp      ! Interpolate to observation space 
     77         ! 
     78         CALL dia_obs_wri     ! Pipe to output files 
     79         ! 
     80         CALL dia_obs_dealloc ! Reset the obs_oper between 
     81         ! 
     82         IF(lk_mpp)   CALL mppstop  ! Safely stop MPI (end mpp communications) 
     83         ! 
    10984   END SUBROUTINE nemo_gcm 
    11085 
     
    11691      !! ** Purpose :   initialization of the NEMO GCM 
    11792      !!---------------------------------------------------------------------- 
    118       INTEGER ::   ji            ! dummy loop indices 
    119       INTEGER ::   ilocal_comm   ! local integer 
    120       INTEGER ::   ios 
    121       CHARACTER(len=80), DIMENSION(16) ::   cltxt 
    122       ! 
    123       NAMELIST/namctl/ ln_ctl, nn_print, nn_ictls, nn_ictle,   & 
    124          &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle,   & 
    125          &             nn_bench, nn_timing 
    126       NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, & 
    127          &             jpizoom, jpjzoom, jperio, ln_use_jattr 
    128       !!---------------------------------------------------------------------- 
    129       ! 
    130       cltxt = '' 
     93      INTEGER ::   ji                 ! dummy loop indices 
     94      INTEGER ::   ios, ilocal_comm   ! local integer 
     95      CHARACTER(len=120), DIMENSION(30) ::   cltxt, cltxt2, clnam 
     96      ! 
     97      NAMELIST/namctl/ ln_ctl   , nn_print, nn_ictls, nn_ictle,   & 
     98         &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,   & 
     99         &             nn_timing, nn_diacfl 
     100      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_write_cfg, cn_domcfg_out, ln_use_jattr 
     101      !!---------------------------------------------------------------------- 
     102      ! 
     103      cltxt  = '' 
     104      cltxt2 = '' 
     105      clnam  = ''   
    131106      cxios_context = 'nemo' 
    132107      ! 
     
    135110      CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
    136111      ! 
    137       REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints & Benchmark 
     112      REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints 
    138113      READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 ) 
    139114901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. ) 
    140  
    141       REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist : Control prints & Benchmark 
     115      ! 
     116      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist 
    142117      READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 ) 
    143118902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. ) 
    144  
    145       ! 
    146       REWIND( numnam_ref )              ! Namelist namcfg in reference namelist : Control prints & Benchmark 
     119      ! 
     120      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist : Control prints 
    147121      READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 
    148122903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. ) 
     
    152126904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )    
    153127 
    154 ! Force values for AGRIF zoom (cf. agrif_user.F90) 
     128      !                             !--------------------------! 
     129      !                             !  Set global domain size  !   (control print return in cltxt2) 
     130      !                             !--------------------------! 
     131      IF( ln_read_cfg ) THEN              ! Read sizes in domain configuration file 
     132         CALL domain_cfg ( cltxt2,        cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     133         ! 
     134      ELSE                                ! user-defined namelist 
     135         CALL usr_def_nam( cltxt2, clnam, cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     136      ENDIF 
     137      ! 
     138      jpk = jpkglo 
     139      ! 
    155140#if defined key_agrif 
    156    IF( .NOT. Agrif_Root() ) THEN 
    157       jpiglo  = nbcellsx + 2 + 2*nbghostcells 
    158       jpjglo  = nbcellsy + 2 + 2*nbghostcells 
    159       jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci 
    160       jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj 
    161       jpidta  = jpiglo 
    162       jpjdta  = jpjglo 
    163       jpizoom = 1 
    164       jpjzoom = 1 
    165       nperio  = 0 
    166       jperio  = 0 
    167       ln_use_jattr = .false. 
    168    ENDIF 
     141      IF( .NOT. Agrif_Root() ) THEN       ! AGRIF children: specific setting (cf. agrif_user.F90) 
     142         jpiglo  = nbcellsx + 2 + 2*nbghostcells 
     143         jpjglo  = nbcellsy + 2 + 2*nbghostcells 
     144         jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci 
     145         jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj 
     146         nperio  = 0 
     147         jperio  = 0 
     148         ln_use_jattr = .false. 
     149      ENDIF 
    169150#endif 
    170151      ! 
     
    198179      ENDIF 
    199180#endif 
     181 
    200182      narea = narea + 1                                     ! mynode return the rank of proc (0 --> jpnij -1 ) 
    201183 
     
    209191         WRITE( numond, namctl ) 
    210192         WRITE( numond, namcfg ) 
     193         IF( .NOT.ln_read_cfg ) THEN 
     194            DO ji = 1, SIZE(clnam) 
     195               IF( TRIM(clnam(ji)) /= '' )   WRITE(numond, * ) clnam(ji)     ! namusr_def print 
     196            END DO 
     197         ENDIF 
    211198      ENDIF 
    212199 
    213200      ! If dimensions of processor grid weren't specified in the namelist file 
    214201      ! then we calculate them here now that we have our communicator size 
    215       IF( (jpni < 1) .OR. (jpnj < 1) )THEN 
     202      IF( jpni < 1 .OR. jpnj < 1 ) THEN 
    216203#if   defined key_mpp_mpi 
    217          IF( Agrif_Root() ) CALL nemo_partition(mppsize) 
     204         IF( Agrif_Root() )   CALL nemo_partition( mppsize ) 
    218205#else 
    219206         jpni  = 1 
     
    221208         jpnij = jpni*jpnj 
    222209#endif 
    223       END IF 
    224  
    225       ! Calculate domain dimensions given calculated jpni and jpnj 
    226       ! This used to be done in par_oce.F90 when they were parameters rather 
    227       ! than variables 
    228       IF( Agrif_Root() ) THEN 
     210      ENDIF 
     211 
     212      IF( Agrif_Root() ) THEN       ! AGRIF mother: specific setting from jpni and jpnj 
    229213#if defined key_nemocice_decomp 
    230          jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first  dim. 
    231          jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim.  
     214         jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci    ! first  dim. 
     215         jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj    ! second dim.  
    232216#else 
    233          jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   ! first  dim. 
    234          jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   ! second dim. 
     217         jpi = ( jpiglo     -2*jpreci + (jpni-1) ) / jpni + 2*jpreci    ! first  dim. 
     218         jpj = ( jpjglo     -2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj    ! second dim. 
    235219#endif 
    236220      ENDIF 
    237          jpk = jpkdta                                             ! third dim 
    238          jpim1 = jpi-1                                            ! inner domain indices 
    239          jpjm1 = jpj-1                                            !   "           " 
    240          jpkm1 = jpk-1                                            !   "           " 
    241          jpij  = jpi*jpj                                          !  jpi x j 
     221 
     222!!gm ???    why here  it has already been done in line 301 ! 
     223      jpk = jpkglo                                             ! third dim 
     224!!gm end 
     225      jpim1 = jpi-1                                            ! inner domain indices 
     226      jpjm1 = jpj-1                                            !   "           " 
     227      jpkm1 = jpk-1                                            !   "           " 
     228      jpij  = jpi*jpj                                          !  jpi x j 
    242229 
    243230      IF(lwp) THEN                            ! open listing units 
     
    249236         WRITE(numout,*) '                       NEMO team' 
    250237         WRITE(numout,*) '            Stand Alone Observation operator' 
    251          WRITE(numout,*) '                  version 1.0  (2015) ' 
     238         WRITE(numout,*) '                NEMO version 3.7  (2015) ' 
    252239         WRITE(numout,*) 
    253240         WRITE(numout,*) 
    254241         DO ji = 1, SIZE(cltxt) 
    255             IF( TRIM(cltxt(ji)) /= '' )   WRITE(numout,*) cltxt(ji)      ! control print of mynode 
     242            IF( TRIM(cltxt (ji)) /= '' )   WRITE(numout,*) cltxt(ji)    ! control print of mynode 
    256243         END DO 
    257          WRITE(numout,cform_aaa)                                         ! Flag AAAAAAA 
    258          ! 
    259       ENDIF 
    260  
    261       ! Now we know the dimensions of the grid and numout has been set we can 
    262       ! allocate arrays 
     244         WRITE(numout,*) 
     245         WRITE(numout,*) 
     246         DO ji = 1, SIZE(cltxt2) 
     247            IF( TRIM(cltxt2(ji)) /= '' )   WRITE(numout,*) cltxt2(ji)   ! control print of domain size 
     248         END DO 
     249         ! 
     250         WRITE(numout,cform_aaa)                                        ! Flag AAAAAAA 
     251         ! 
     252      ENDIF 
     253 
     254      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 
    263255      CALL nemo_alloc() 
    264256 
     
    279271                            CALL     phy_cst    ! Physical constants 
    280272                            CALL     eos_init   ! Equation of state 
    281                             CALL     dom_cfg    ! Domain configuration 
    282273                            CALL     dom_init   ! Domain 
    283274 
     
    301292      IF(lwp) THEN                  ! control print 
    302293         WRITE(numout,*) 
    303          WRITE(numout,*) 'nemo_ctl: Control prints & Benchmark' 
     294         WRITE(numout,*) 'nemo_ctl: Control prints' 
    304295         WRITE(numout,*) '~~~~~~~ ' 
    305296         WRITE(numout,*) '   Namelist namctl' 
     
    312303         WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt 
    313304         WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt 
    314          WRITE(numout,*) '      benchmark parameter (0/1)       nn_bench   = ', nn_bench 
    315305         WRITE(numout,*) '      timing activated    (0/1)       nn_timing  = ', nn_timing 
    316306      ENDIF 
     
    323313      isplt     = nn_isplt 
    324314      jsplt     = nn_jsplt 
    325       nbench    = nn_bench 
    326315 
    327316      IF(lwp) THEN                  ! control print 
     
    330319         WRITE(numout,*) '~~~~~~~ ' 
    331320         WRITE(numout,*) '   Namelist namcfg' 
    332          WRITE(numout,*) '      configuration name              cp_cfg      = ', TRIM(cp_cfg) 
    333          WRITE(numout,*) '      configuration zoom name         cp_cfz      = ', TRIM(cp_cfz) 
    334          WRITE(numout,*) '      configuration resolution        jp_cfg      = ', jp_cfg 
    335          WRITE(numout,*) '      1st lateral dimension ( >= jpi ) jpidta     = ', jpidta 
    336          WRITE(numout,*) '      2nd    "         "    ( >= jpj ) jpjdta     = ', jpjdta 
    337          WRITE(numout,*) '      3nd    "         "               jpkdta     = ', jpkdta 
    338          WRITE(numout,*) '      1st dimension of global domain in i jpiglo  = ', jpiglo 
    339          WRITE(numout,*) '      2nd    -                  -    in j jpjglo  = ', jpjglo 
    340          WRITE(numout,*) '      left bottom i index of the zoom (in data domain) jpizoom = ', jpizoom 
    341          WRITE(numout,*) '      left bottom j index of the zoom (in data domain) jpizoom = ', jpjzoom 
    342          WRITE(numout,*) '      lateral cond. type (between 0 and 6) jperio = ', jperio    
    343          WRITE(numout,*) '      use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 
     321         WRITE(numout,*) '      read domain configuration file                ln_read_cfg      = ', ln_read_cfg 
     322         WRITE(numout,*) '         filename to be read                           cn_domcfg     = ', TRIM(cn_domcfg) 
     323         WRITE(numout,*) '      write configuration definition file           ln_write_cfg     = ', ln_write_cfg 
     324         WRITE(numout,*) '         filename to be written                        cn_domcfg_out = ', TRIM(cn_domcfg_out) 
     325         WRITE(numout,*) '      use file attribute if exists as i/p j-start   ln_use_jattr     = ', ln_use_jattr 
    344326      ENDIF 
    345327      !                             ! Parameter control 
     
    382364      ENDIF 
    383365      ! 
    384       IF( nbench == 1 ) THEN              ! Benchmark 
    385          SELECT CASE ( cp_cfg ) 
    386          CASE ( 'gyre' )   ;   CALL ctl_warn( ' The Benchmark is activated ' ) 
    387          CASE DEFAULT      ;   CALL ctl_stop( ' The Benchmark is based on the GYRE configuration:',   & 
    388             &                                 ' cp_cfg = "gyre" in namelist &namcfg or set nbench = 0' ) 
    389          END SELECT 
    390       ENDIF 
    391       ! 
    392366      IF( 1_wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ',  & 
    393367         &                                               'f2003 standard. '                              ,  & 
     
    421395      IF( numdct_heat     /= -1 )   CLOSE( numdct_heat     )   ! heat transports 
    422396      IF( numdct_salt     /= -1 )   CLOSE( numdct_salt     )   ! salt transports 
    423  
    424397      ! 
    425398      numout = 6                                     ! redefine numout in case it is used after this point... 
     
    460433      !! ** Method  : 
    461434      !!---------------------------------------------------------------------- 
    462       INTEGER, INTENT(in) :: num_pes ! The number of MPI processes we have 
     435      INTEGER, INTENT(in) ::   num_pes  ! The number of MPI processes we have 
    463436      ! 
    464437      INTEGER, PARAMETER :: nfactmax = 20 
     
    514487      INTEGER :: ifac, jl, inu 
    515488      INTEGER, PARAMETER :: ntest = 14 
    516       INTEGER :: ilfax(ntest) 
     489      INTEGER, DIMENSION(ntest) ::   ilfax 
     490      !!---------------------------------------------------------------------- 
    517491      ! 
    518492      ! lfax contains the set of allowed factors. 
    519       data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256,  & 
    520          &                            128,   64,   32,   16,    8,   4,   2  / 
    521       !!---------------------------------------------------------------------- 
    522  
     493      ilfax(:) = (/(2**jl,jl=ntest,1,-1)/) 
     494      ! 
    523495      ! Clear the error flag and initialise output vars 
    524       kerr = 0 
    525       kfax = 1 
     496      kerr  = 0 
     497      kfax  = 1 
    526498      knfax = 0 
    527  
     499      ! 
    528500      ! Find the factors of n. 
    529501      IF( kn == 1 )   GOTO 20 
     
    533505      ! l points to the allowed factor list. 
    534506      ! ifac holds the current factor. 
    535  
     507      ! 
    536508      inu   = kn 
    537509      knfax = 0 
    538  
     510      ! 
    539511      DO jl = ntest, 1, -1 
    540512         ! 
     
    560532         ! 
    561533      END DO 
    562  
     534      ! 
    563535   20 CONTINUE      ! Label 20 is the exit point from the factor search loop. 
    564536      ! 
     
    568540 
    569541   SUBROUTINE nemo_northcomms 
    570       !!====================================================================== 
     542      !!---------------------------------------------------------------------- 
    571543      !!                     ***  ROUTINE  nemo_northcomms  *** 
    572       !! nemo_northcomms    :  Setup for north fold exchanges with explicit  
    573       !!                       point-to-point messaging 
    574       !!===================================================================== 
    575       !!---------------------------------------------------------------------- 
    576       !! 
    577       !! ** Purpose :   Initialization of the northern neighbours lists. 
     544      !! ** Purpose :   Setup for north fold exchanges with explicit  
     545      !!                point-to-point messaging 
     546      !! 
     547      !! ** Method :   Initialization of the northern neighbours lists. 
    578548      !!---------------------------------------------------------------------- 
    579549      !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) 
    580550      !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC)  
    581551      !!---------------------------------------------------------------------- 
    582  
    583552      INTEGER  ::   sxM, dxM, sxT, dxT, jn 
    584553      INTEGER  ::   njmppmax 
    585  
     554      !!---------------------------------------------------------------------- 
     555      ! 
    586556      njmppmax = MAXVAL( njmppt ) 
    587      
     557      ! 
    588558      !initializes the north-fold communication variables 
    589559      isendto(:) = 0 
    590       nsndto = 0 
    591  
     560      nsndto     = 0 
     561      ! 
    592562      !if I am a process in the north 
    593563      IF ( njmpp == njmppmax ) THEN 
     
    611581                IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 
    612582                   nsndto = nsndto + 1 
    613                      isendto(nsndto) = jn 
     583                   isendto(nsndto) = jn 
    614584                ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN 
    615585                   nsndto = nsndto + 1 
    616                      isendto(nsndto) = jn 
     586                   isendto(nsndto) = jn 
    617587                ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN 
    618588                   nsndto = nsndto + 1 
    619                      isendto(nsndto) = jn 
    620                 END IF 
     589                   isendto(nsndto) = jn 
     590                ENDIF 
    621591          END DO 
    622592          nfsloop = 1 
     
    636606      l_north_nogather = .TRUE. 
    637607   END SUBROUTINE nemo_northcomms 
     608 
    638609#else 
    639610   SUBROUTINE nemo_northcomms      ! Dummy routine 
     
    645616END MODULE nemogcm 
    646617 
    647  
Note: See TracChangeset for help on using the changeset viewer.