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 7200 for branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/SAO_SRC – NEMO

Ignore:
Timestamp:
2016-11-06T17:31:33+01:00 (8 years ago)
Author:
gm
Message:

#1692 - branch SIMPLIF_2_usrdef: add depth_e3 module + management of ORCA family + domain_cfg filename (in&out) given in namelist

Location:
branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/SAO_SRC
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/SAO_SRC/nemogcm.F90

    r6982 r7200  
    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-10  (A. C. Coward, NOCS & J. Donners, PRACE) add nemo_northcomms 
    31    !!             -   ! 2011-11  (C. Harris) decomposition changes for running with CICE 
    32    !!            3.6  ! 2012-05  (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening  
    33    !!             -   ! 2013-06  (I. Epicoco, S. Mocavero, CMCC) nemo_northcomms: setup avoiding MPI communication  
    34    !!             -   ! 2014-12  (G. Madec) remove KPP scheme and cross-land advection (cla) 
     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 
    358   !!---------------------------------------------------------------------- 
    369 
    3710   !!---------------------------------------------------------------------- 
    38    !!   nemo_gcm       : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice 
    39    !!   nemo_init      : initialization of the NEMO system 
    40    !!   nemo_ctl       : initialisation of the contol print 
    41    !!   nemo_closefile : close remaining open files 
    42    !!   nemo_alloc     : dynamical allocation 
    43    !!   nemo_partition : calculate MPP domain decomposition 
    44    !!   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 
    4518   !!---------------------------------------------------------------------- 
    4619   USE step_oce       ! module used in the ocean time stepping module (step.F90) 
    47    USE domcfg         ! domain configuration               (dom_cfg routine) 
    48    USE mppini         ! shared/distributed memory setting (mpp_init routine) 
    49    USE domain         ! domain initialization             (dom_init routine) 
     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) 
    5026#if defined key_nemocice_decomp 
    5127   USE ice_domain_size, only: nx_global, ny_global 
    5228#endif 
    53    USE istate          ! initial state setting          (istate_init routine) 
    54    USE phycst          ! physical constant                  (par_cst routine) 
    55    USE diaobs          ! Observation diagnostics       (dia_obs_init routine) 
    56    USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    57    USE step            ! NEMO time-stepping                 (stp     routine) 
    58    USE cpl_oasis3      ! OASIS3 coupling 
    59    USE lib_mpp         ! distributed memory computing 
     29   !           ! Stand Alone Observation operator modules 
     30   USE sao_data 
     31   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) 
    6037#if defined key_iomput 
    6138   USE xios           ! xIOserver 
    6239#endif 
    63    USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges  
    64  
    65    ! Stand Alone Observation operator modules 
    66    USE sao_data 
    67    USE sao_intp 
    6840 
    6941   IMPLICIT NONE 
    … …  
    9466         !!             3. Cycle through match ups 
    9567         !!             4. Write results to file 
    96          !! 
    9768         !!---------------------------------------------------------------------- 
    98          !! Initialise NEMO 
    99          CALL nemo_init 
    100          !! Initialise Stand Alone Observation operator data 
    101          CALL sao_data_init 
    102          !! Initialise obs_oper 
    103          CALL dia_obs_init 
    104          !! Interpolate to observation space 
    105          CALL sao_interp 
    106          !! Pipe to output files 
    107          CALL dia_obs_wri 
    108          !! Reset the obs_oper between 
    109          CALL dia_obs_dealloc 
    110          !! Safely stop MPI 
    111          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         ! 
    11284   END SUBROUTINE nemo_gcm 
    11385 
    … …  
    11991      !! ** Purpose :   initialization of the NEMO GCM 
    12092      !!---------------------------------------------------------------------- 
    121       INTEGER ::   ji            ! dummy loop indices 
    122       INTEGER ::   ilocal_comm   ! local integer 
    123       INTEGER ::   ios 
    124 !!gm      CHARACTER(len=80), DIMENSION(16) ::   cltxt 
    125       CHARACTER(len=80), DIMENSION(-10:16) ::   cltxt 
    126       ! 
    127       NAMELIST/namctl/ ln_ctl, nn_print, nn_ictls, nn_ictle,   & 
    128          &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle,   & 
     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,   & 
    12999         &             nn_timing, nn_diacfl 
    130       NAMELIST/namcfg/ ln_read_cfg, ln_write_cfg, cp_cfg, jp_cfg, ln_use_jattr 
    131       !!---------------------------------------------------------------------- 
    132       ! 
    133       cltxt = '' 
     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  = ''   
    134106      cxios_context = 'nemo' 
    135107      ! 
    … …  
    138110      CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
    139111      ! 
    140       REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints & Benchmark 
     112      REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints 
    141113      READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 ) 
    142114901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. ) 
    143  
    144       REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist : Control prints & Benchmark 
     115      ! 
     116      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist 
    145117      READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 ) 
    146118902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. ) 
    147  
    148       ! 
    149       REWIND( numnam_ref )              ! Namelist namcfg in reference namelist : Control prints & Benchmark 
     119      ! 
     120      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist : Control prints 
    150121      READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 
    151122903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. ) 
    … …  
    155126904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )    
    156127 
    157 !!gm      WRITE(clbug(3),*) ' after namelist namcfg read    nstop', nstop 
    158  
    159128      !                             !--------------------------! 
    160129      !                             !  Set global domain size  !   (control print return in cltxt2) 
    161130      !                             !--------------------------! 
    162       IF( ln_read_cfg ) THEN              ! Read sizes in configuration "mesh_mask" file 
    163          CALL iom_open( 'domain_cfg', inum ) 
    164          CALL iom_get( inum, 'jpiglo', ziglo  )   ;   jpiglo = INT( ziglo ) 
    165          CALL iom_get( inum, 'jpjglo', zjglo  )   ;   jpjglo = INT( zjglo ) 
    166          CALL iom_get( inum, 'jpkglo', zkglo  )   ;   jpkglo = INT( zkglo ) 
    167          CALL iom_get( inum, 'jperio', zperio )   ;   jperio = INT( zperio ) 
    168          CALL iom_close( inum ) 
    169          WRITE(cltxt2(1),*)        
    170          WRITE(cltxt2(2),*) 'domain_cfg : domain size read in "domain_cfg" file : jp(i,j,k)glo = ', jpiglo, jpjglo, jpkglo         
    171          WRITE(cltxt2(3),*) '~~~~~~~~~~   lateral boudary type of the global domain      jperio= ', jperio 
    172          !         
     131      IF( ln_read_cfg ) THEN              ! Read sizes in domain configuration file 
     132         CALL domain_cfg ( cltxt2, clnam, cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     133         ! 
    173134      ELSE                                ! user-defined namelist 
    174          CALL usr_def_nam( cltxt2, clnam, jpiglo, jpjglo, jpkglo, jperio ) 
    175       ENDIF 
    176       jpk    = jpkglo 
     135         CALL usr_def_nam( cltxt2, clnam, cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     136      ENDIF 
     137      ! 
     138      jpk = jpkglo 
    177139      ! 
    178140#if defined key_agrif 
    … …  
    217179      ENDIF 
    218180#endif 
     181 
    219182      narea = narea + 1                                     ! mynode return the rank of proc (0 --> jpnij -1 ) 
    220183 
    … …  
    230193         IF( .NOT.ln_read_cfg ) THEN 
    231194            DO ji = 1, SIZE(clnam) 
    232                IF( TRIM(clnam (ji)) /= '' )   WRITE(numond, * ) clnam(ji)    ! namusr_def print 
     195               IF( TRIM(clnam(ji)) /= '' )   WRITE(numond, * ) clnam(ji)     ! namusr_def print 
    233196            END DO 
    234197         ENDIF 
    … …  
    239202      IF( jpni < 1 .OR. jpnj < 1 ) THEN 
    240203#if   defined key_mpp_mpi 
    241          IF( Agrif_Root() ) CALL nemo_partition(mppsize) 
     204         IF( Agrif_Root() )   CALL nemo_partition( mppsize ) 
    242205#else 
    243206         jpni  = 1 
    … …  
    247210      ENDIF 
    248211 
    249       ! Calculate domain dimensions given calculated jpni and jpnj 
    250       ! This used to be done in par_oce.F90 when they were parameters rather 
    251       ! than variables 
    252       IF( Agrif_Root() ) THEN 
     212      IF( Agrif_Root() ) THEN       ! AGRIF mother: specific setting from jpni and jpnj 
    253213#if defined key_nemocice_decomp 
    254          jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first  dim. 
    255          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.  
    256216#else 
    257          jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   ! first  dim. 
    258          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. 
    259219#endif 
    260220      ENDIF 
    … …  
    272232         CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 
    273233         ! 
    274  
    275          DO ji = 1, SIZE(clbug) 
    276             IF( TRIM(clbug (ji)) /= '' )   WRITE(numout,*) clbug(ji)      ! bug print  
    277          END DO 
    278          WRITE(numout,*) 
    279  
    280  
    281  
    282  
    283234         WRITE(numout,*) 
    284235         WRITE(numout,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - INGV - CMCC' 
    285236         WRITE(numout,*) '                       NEMO team' 
    286237         WRITE(numout,*) '            Stand Alone Observation operator' 
    287          WRITE(numout,*) '                  version 1.0  (2015) ' 
     238         WRITE(numout,*) '                NEMO version 3.7  (2015) ' 
    288239         WRITE(numout,*) 
    289240         WRITE(numout,*) 
    290241         DO ji = 1, SIZE(cltxt) 
    291             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 
    292243         END DO 
    293          WRITE(numout,cform_aaa)                                         ! Flag AAAAAAA 
    294          ! 
    295       ENDIF 
    296  
    297       ! Now we know the dimensions of the grid and numout has been set we can 
    298       ! 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 
    299255      CALL nemo_alloc() 
    300256 
    … …  
    315271                            CALL     phy_cst    ! Physical constants 
    316272                            CALL     eos_init   ! Equation of state 
    317                             CALL     dom_cfg    ! Domain configuration 
    318273                            CALL     dom_init   ! Domain 
    319274 
    … …  
    337292      IF(lwp) THEN                  ! control print 
    338293         WRITE(numout,*) 
    339          WRITE(numout,*) 'nemo_ctl: Control prints & Benchmark' 
     294         WRITE(numout,*) 'nemo_ctl: Control prints' 
    340295         WRITE(numout,*) '~~~~~~~ ' 
    341296         WRITE(numout,*) '   Namelist namctl' 
    … …  
    364319         WRITE(numout,*) '~~~~~~~ ' 
    365320         WRITE(numout,*) '   Namelist namcfg' 
    366          WRITE(numout,*) '      read configuration definition files          ln_read_cfg = ', ln_read_cfg 
    367          WRITE(numout,*) '      configuration name                               cp_cfg  = ', TRIM(cp_cfg) 
    368          WRITE(numout,*) '      configuration resolution                         jp_cfg  = ', jp_cfg 
    369          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 
    370326      ENDIF 
    371327      !                             ! Parameter control 
    … …  
    439395      IF( numdct_heat     /= -1 )   CLOSE( numdct_heat     )   ! heat transports 
    440396      IF( numdct_salt     /= -1 )   CLOSE( numdct_salt     )   ! salt transports 
    441  
    442397      ! 
    443398      numout = 6                                     ! redefine numout in case it is used after this point... 
    … …  
    478433      !! ** Method  : 
    479434      !!---------------------------------------------------------------------- 
    480       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 
    481436      ! 
    482437      INTEGER, PARAMETER :: nfactmax = 20 
    … …  
    532487      INTEGER :: ifac, jl, inu 
    533488      INTEGER, PARAMETER :: ntest = 14 
    534       INTEGER :: ilfax(ntest) 
     489      INTEGER, DIMENSION(ntest) ::   ilfax 
     490      !!---------------------------------------------------------------------- 
    535491      ! 
    536492      ! lfax contains the set of allowed factors. 
    537       data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256,  & 
    538          &                            128,   64,   32,   16,    8,   4,   2  / 
    539       !!---------------------------------------------------------------------- 
    540  
     493      ilfax(:) = (/(2**jl,jl=ntest,1,-1)/) 
     494      ! 
    541495      ! Clear the error flag and initialise output vars 
    542       kerr = 0 
    543       kfax = 1 
     496      kerr  = 0 
     497      kfax  = 1 
    544498      knfax = 0 
    545  
     499      ! 
    546500      ! Find the factors of n. 
    547501      IF( kn == 1 )   GOTO 20 
    … …  
    551505      ! l points to the allowed factor list. 
    552506      ! ifac holds the current factor. 
    553  
     507      ! 
    554508      inu   = kn 
    555509      knfax = 0 
    556  
     510      ! 
    557511      DO jl = ntest, 1, -1 
    558512         ! 
    … …  
    578532         ! 
    579533      END DO 
    580  
     534      ! 
    581535   20 CONTINUE      ! Label 20 is the exit point from the factor search loop. 
    582536      ! 
    … …  
    586540 
    587541   SUBROUTINE nemo_northcomms 
    588       !!====================================================================== 
     542      !!---------------------------------------------------------------------- 
    589543      !!                     ***  ROUTINE  nemo_northcomms  *** 
    590       !! nemo_northcomms    :  Setup for north fold exchanges with explicit  
    591       !!                       point-to-point messaging 
    592       !!===================================================================== 
    593       !!---------------------------------------------------------------------- 
    594       !! 
    595       !! ** 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. 
    596548      !!---------------------------------------------------------------------- 
    597549      !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) 
    598550      !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC)  
    599551      !!---------------------------------------------------------------------- 
    600  
    601552      INTEGER  ::   sxM, dxM, sxT, dxT, jn 
    602553      INTEGER  ::   njmppmax 
    603  
     554      !!---------------------------------------------------------------------- 
     555      ! 
    604556      njmppmax = MAXVAL( njmppt ) 
    605      
     557      ! 
    606558      !initializes the north-fold communication variables 
    607559      isendto(:) = 0 
    608       nsndto = 0 
    609  
     560      nsndto     = 0 
     561      ! 
    610562      !if I am a process in the north 
    611563      IF ( njmpp == njmppmax ) THEN 
    … …  
    629581                IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 
    630582                   nsndto = nsndto + 1 
    631                      isendto(nsndto) = jn 
     583                   isendto(nsndto) = jn 
    632584                ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN 
    633585                   nsndto = nsndto + 1 
    634                      isendto(nsndto) = jn 
     586                   isendto(nsndto) = jn 
    635587                ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN 
    636588                   nsndto = nsndto + 1 
    637                      isendto(nsndto) = jn 
    638                 END IF 
     589                   isendto(nsndto) = jn 
     590                ENDIF 
    639591          END DO 
    640592          nfsloop = 1 
    … …  
    654606      l_north_nogather = .TRUE. 
    655607   END SUBROUTINE nemo_northcomms 
     608 
    656609#else 
    657610   SUBROUTINE nemo_northcomms      ! Dummy routine 
    … …  
    663616END MODULE nemogcm 
    664617 
    665  

  • branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/SAO_SRC/sao_data.F90

    r5063 r7200  
    11MODULE sao_data 
    2    !! ================================================================= 
    3    !!                    *** MODULE sao_data *** 
    4    !! ================================================================= 
     2   !!====================================================================== 
     3   !!                       ***  MODULE sao_data  *** 
     4   !!====================================================================== 
     5   !! History :  3.6  ! 2015-12  (A. Ryan)  Original code 
     6   !!---------------------------------------------------------------------- 
    57   USE par_kind, ONLY: lc 
    68   USE lib_mpp         ! distributed memory computing 
     9   USE in_out_manager 
    710 
    811   IMPLICIT NONE 
    9  
    10    !! Public data 
    1112 
    1213   INTEGER, PARAMETER :: MaxNumFiles = 1000 
    1314 
    1415   !! Stand Alone Observation operator settings 
    15    CHARACTER(len=lc) :: & 
    16       & sao_files(MaxNumFiles)         !: model files 
    17    INTEGER            :: & 
    18       & n_files, &                     !: number of files 
    19       & nn_sao_idx(MaxNumFiles), &     !: time_counter indices 
    20       & nn_sao_freq                    !: read frequency in time steps 
     16   CHARACTER(len=lc) ::   sao_files(MaxNumFiles)   !: model files 
     17   INTEGER           ::   n_files                  !: number of files 
     18   INTEGER           :: nn_sao_idx(MaxNumFiles)    !: time_counter indices 
     19   INTEGER           :: nn_sao_freq                !: read frequency in time steps 
     20    
     21   !!---------------------------------------------------------------------- 
     22   !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
     23   !! $Id: trazdf_imp.F90 6140 2015-12-21 11:35:23Z timgraham $ 
     24   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     25   !!---------------------------------------------------------------------- 
    2126CONTAINS 
     27 
    2228   SUBROUTINE sao_data_init() 
    2329      !!---------------------------------------------------------------------- 
    … …  
    2733      !! 
    2834      !!---------------------------------------------------------------------- 
    29       USE in_out_manager 
    30       INTEGER            :: & 
    31          & jf                           !: file dummy loop index 
    32       LOGICAL :: lmask(MaxNumFiles)     !: Logical mask used for counting 
    33       INTEGER :: ios 
    34  
    35       ! Standard offline obs_oper information 
     35      INTEGER ::   jf                   ! file dummy loop index 
     36      LOGICAL ::   lmask(MaxNumFiles)   ! Logical mask used for counting 
     37      INTEGER ::   ios 
     38      !! 
    3639      NAMELIST/namsao/sao_files, nn_sao_idx, nn_sao_freq 
     40      !!---------------------------------------------------------------------- 
    3741 
    3842      ! Standard offline obs_oper initialisation 
    39       n_files = 0                   !: number of files to cycle through 
    40       sao_files(:) = ''             !: list of files to read in 
    41       nn_sao_idx(:) = 0             !: list of indices inside each file 
    42       nn_sao_freq = -1              !: input frequency in time steps 
     43      n_files = 0                   ! number of files to cycle through 
     44      sao_files(:) = ''             ! list of files to read in 
     45      nn_sao_idx(:) = 0             ! list of indices inside each file 
     46      nn_sao_freq = -1              ! input frequency in time steps 
    4347 
    4448      ! Standard offline obs_oper settings 
    … …  
    4650      READ  ( numnam_ref, namsao, IOSTAT = ios, ERR = 901 ) 
    4751901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsao in reference namelist', .TRUE. ) 
    48  
     52      ! 
    4953      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist : Control prints & Benchmark 
    5054      READ  ( numnam_cfg, namsao, IOSTAT = ios, ERR = 902 ) 
    5155902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsao in configuration namelist', .TRUE. ) 
    52  
    53  
    54       ! count input files 
    55       lmask(:) = .FALSE. 
     56      
     57      lmask(:) = .FALSE.               ! count input files 
    5658      WHERE (sao_files(:) /= '') lmask(:) = .TRUE. 
    5759      n_files = COUNT(lmask) 
    58  
    59       !! Initialise sub obs window frequency 
    60       IF (nn_sao_freq == -1) THEN 
    61          !! Run length 
    62          nn_sao_freq = nitend - nit000 + 1 
     60      ! 
     61      IF(nn_sao_freq == -1) THEN      ! Initialise sub obs window frequency 
     62         nn_sao_freq = nitend - nit000 + 1      ! Run length 
    6363      ENDIF 
    64  
    65       !! Print summary of settings 
    66       IF(lwp) THEN 
     64      ! 
     65      IF(lwp) THEN                     ! Print summary of settings 
    6766         WRITE(numout,*) 
    6867         WRITE(numout,*) 'offline obs_oper : Initialization' 
    … …  
    7069         WRITE(numout,*) '   Namelist namsao : set stand alone obs_oper parameters' 
    7170         DO jf = 1, n_files 
    72             WRITE(numout,'(1X,2A)') '   Input forecast file name          forecastfile = ', & 
    73                TRIM(sao_files(jf)) 
    74             WRITE(numout,*) '   Input forecast file index        forecastindex = ', & 
    75                nn_sao_idx(jf) 
     71            WRITE(numout,'(1X,2A)') '   Input forecast file name          forecastfile = ', TRIM(sao_files(jf)) 
     72            WRITE(numout,*) '   Input forecast file index        forecastindex = ', nn_sao_idx(jf) 
    7673         END DO 
    7774      END IF 
    78  
     75      ! 
    7976   END SUBROUTINE sao_data_init 
    8077 
     78   !!====================================================================== 
    8179END MODULE sao_data 
    8280 

  • branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/SAO_SRC/sao_intp.F90

    r5063 r7200  
    44   !! ** Purpose : Run NEMO observation operator in offline mode 
    55   !!====================================================================== 
    6    !! NEMO modules 
     6   !! History :  3.6  ! 2015-12  (A. Ryan)  Original code 
     7   !!---------------------------------------------------------------------- 
     8   !        ! NEMO modules 
    79   USE in_out_manager 
    810   USE diaobs 
    9    !! Stand Alone Observation operator modules 
     11   !        ! Stand Alone Observation operator modules 
    1012   USE sao_read 
    1113   USE sao_data 
    … …  
    1618   PUBLIC sao_interp 
    1719 
    18    CONTAINS 
     20   !!---------------------------------------------------------------------- 
     21   !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
     22   !! $Id: trazdf_imp.F90 6140 2015-12-21 11:35:23Z timgraham $ 
     23   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     24   !!---------------------------------------------------------------------- 
     25CONTAINS 
    1926 
    20       SUBROUTINE sao_interp 
    21          !!---------------------------------------------------------------------- 
    22          !!                    ***  SUBROUTINE sao_interp *** 
    23          !! 
    24          !! ** Purpose : To interpolate the model as if it were running online. 
    25          !! 
    26          !! ** Method : 1. Populate model counterparts 
    27          !!             2. Call dia_obs at appropriate time steps 
    28          !!---------------------------------------------------------------------- 
    29          INTEGER :: & 
    30             & istp, & ! time step index 
    31             & ifile   ! file index 
    32          istp = nit000 - 1 
    33          nstop = 0 
    34          ifile = 1 
    35          CALL sao_rea_dri(ifile) 
    36          DO WHILE ( istp <= nitend .AND. nstop == 0 ) 
    37             IF (ifile <= n_files + 1) THEN 
    38                IF ( MOD(istp, nn_sao_freq) == nit000 ) THEN 
    39                   CALL sao_rea_dri(ifile) 
    40                   ifile = ifile + 1 
    41                ENDIF 
    42                CALL dia_obs(istp) 
     27   SUBROUTINE sao_interp 
     28      !!---------------------------------------------------------------------- 
     29      !!                    ***  SUBROUTINE sao_interp *** 
     30      !! 
     31      !! ** Purpose : To interpolate the model as if it were running online. 
     32      !! 
     33      !! ** Method : 1. Populate model counterparts 
     34      !!             2. Call dia_obs at appropriate time steps 
     35      !!---------------------------------------------------------------------- 
     36      INTEGER ::   istp    ! time step index 
     37      INTEGER ::   ifile   ! file index 
     38      !!---------------------------------------------------------------------- 
     39      istp = nit000 - 1 
     40      nstop = 0 
     41      ifile = 1 
     42      CALL sao_rea_dri(ifile) 
     43      ! 
     44      DO WHILE ( istp <= nitend .AND. nstop == 0 ) 
     45         IF (ifile <= n_files + 1) THEN 
     46            IF ( MOD(istp, nn_sao_freq) == nit000 ) THEN 
     47               CALL sao_rea_dri(ifile) 
     48               ifile = ifile + 1 
    4349            ENDIF 
    44             istp = istp + 1 
    45          END DO 
    46       END SUBROUTINE sao_interp 
     50            CALL dia_obs(istp) 
     51         ENDIF 
     52         istp = istp + 1 
     53      END DO 
     54      ! 
     55   END SUBROUTINE sao_interp 
    4756 
     57   !!====================================================================== 
    4858END MODULE sao_intp 

  • branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/SAO_SRC/sao_read.F90

    r5063 r7200  
    11MODULE sao_read 
    2    !!================================================================== 
    3    !!                    *** MODULE sao_read *** 
     2   !!====================================================================== 
     3   !!                      ***  MODULE sao_read *** 
    44   !! Read routines : I/O for Stand Alone Observation operator 
    5    !!================================================================== 
     5   !!====================================================================== 
    66   USE mppini 
    77   USE lib_mpp 
    … …  
    1212   USE dom_oce, ONLY: nlci, nlcj, nimpp, njmpp, tmask 
    1313   USE par_oce, ONLY: jpi, jpj, jpk 
     14   ! 
    1415   USE obs_fbm, ONLY: fbimdi, fbrmdi, fbsp, fbdp 
    1516   USE sao_data 
    … …  
    2021   PUBLIC sao_rea_dri 
    2122 
     23   !!---------------------------------------------------------------------- 
     24   !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
     25   !! $Id: trazdf_imp.F90 6140 2015-12-21 11:35:23Z timgraham $ 
     26   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     27   !!---------------------------------------------------------------------- 
    2228CONTAINS 
    23    SUBROUTINE sao_rea_dri(kfile) 
     29 
     30   SUBROUTINE sao_rea_dri( kfile ) 
    2431      !!------------------------------------------------------------------------ 
    2532      !!             *** sao_rea_dri *** 
    … …  
    3138      !! 
    3239      !!------------------------------------------------------------------------ 
    33       INTEGER, INTENT(IN) :: & 
    34               & kfile         !: File number 
    35       CHARACTER(len=lc) :: & 
    36               & cdfilename    !: File name 
    37       INTEGER :: & 
    38               & kindex        !: File index to read 
    39  
    40       cdfilename = TRIM(sao_files(kfile)) 
     40      INTEGER, INTENT(in) ::   kfile         ! File number 
     41      ! 
     42      CHARACTER(len=lc)   ::   cdfilename    ! File name 
     43      INTEGER ::   kindex        ! File index to read 
     44      !!------------------------------------------------------------------------ 
     45      ! 
     46      cdfilename = TRIM( sao_files(kfile) ) 
    4147      kindex = nn_sao_idx(kfile) 
    42       CALL sao_read_file(TRIM(cdfilename), kindex) 
    43  
     48      CALL sao_read_file( TRIM( cdfilename ), kindex ) 
     49      ! 
    4450   END SUBROUTINE sao_rea_dri 
    4551 
    46    SUBROUTINE sao_read_file(filename, ifcst) 
     52 
     53   SUBROUTINE sao_read_file( filename, ifcst ) 
    4754      !!------------------------------------------------------------------------ 
    48       !!             *** sao_read_file *** 
     55      !!                         ***  sao_read_file *** 
    4956      !! 
    5057      !! Purpose : To fill tn and sn with dailymean field from netcdf files 
    … …  
    5461      !! Author  : A. Ryan Oct 2010 
    5562      !!------------------------------------------------------------------------ 
    56  
    57       INTEGER,          INTENT(IN) :: ifcst 
    58       CHARACTER(len=*), INTENT(IN) :: filename 
    59       INTEGER                      :: ncid, & 
    60                                     & varid,& 
    61                                     & istat,& 
    62                                     & ntimes,& 
    63                                     & tdim, & 
    64                                     & xdim, & 
    65                                     & ydim, & 
    66                                     & zdim 
    67       INTEGER                      :: ii, ij, ik 
    68       INTEGER, DIMENSION(4)        :: start_n, & 
    69                                     & count_n 
    70       INTEGER, DIMENSION(3)        :: start_s, & 
    71                                     & count_s 
    72       REAL(fbdp), DIMENSION(:,:,:),ALLOCATABLE :: temp_tn, & 
    73                                               & temp_sn 
    74       REAL(fbdp), DIMENSION(:,:),  ALLOCATABLE :: temp_sshn 
    75       REAL(fbdp)                     :: fill_val 
     63      INTEGER,          INTENT(in) ::   ifcst 
     64      CHARACTER(len=*), INTENT(in) ::   filename 
     65      INTEGER                      ::   ncid, varid, istat, ntimes 
     66      INTEGER                      ::   tdim, xdim, ydim, zdim 
     67      INTEGER                      ::   ii, ij, ik 
     68      INTEGER, DIMENSION(4)        ::   start_n, count_n 
     69      INTEGER, DIMENSION(3)        ::   start_s, count_s 
     70      REAL(fbdp)                   ::   fill_val 
     71      REAL(fbdp), DIMENSION(:,:,:), ALLOCATABLE ::   temp_tn, temp_sn 
     72      REAL(fbdp), DIMENSION(:,:)  , ALLOCATABLE ::   temp_sshn 
    7673 
    7774      ! DEBUG 
    78       INTEGER :: istage 
     75      INTEGER ::   istage 
     76      !!------------------------------------------------------------------------ 
    7977 
    8078      IF (TRIM(filename) == 'nofile') THEN 
    81          tsn(:,:,:,:) = fbrmdi 
    82          sshn(:,:) = fbrmdi 
     79         tsn (:,:,:,:) = fbrmdi 
     80         sshn(:,:)     = fbrmdi 
    8381      ELSE 
    8482         WRITE(numout,*) "Opening :", TRIM(filename) 
    … …  
    169167         istat = nf90_close(ncid) 
    170168      END IF 
     169      ! 
    171170   END SUBROUTINE sao_read_file 
     171    
     172   !!------------------------------------------------------------------------ 
    172173END MODULE sao_read 
Note: See TracChangeset for help on using the changeset viewer.