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 5832 for branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90 – NEMO

Ignore:
Timestamp:
2015-10-26T10:08:06+01:00 (8 years ago)
Author:
timgraham
Message:

Upgraded to trunk revision r5518 (NEMO 3.6 stable)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90

    • Property svn:keywords set to Id
    r4715 r5832  
    1818   USE c1d             ! 1D configuration 
    1919   USE domcfg          ! domain configuration               (dom_cfg routine) 
    20    USE domain          ! domain initialization             (dom_init routine) 
    21    USE istate          ! initial state setting          (istate_init routine) 
     20   USE domain          ! domain initialization from coordinate & bathymetry (dom_init routine) 
     21   USE domrea          ! domain initialization from mesh_mask            (dom_init routine) 
    2222   USE eosbn2          ! equation of state            (eos bn2 routine) 
    2323   !              ! ocean physics 
     
    3434   USE trcstp          ! passive tracer time-stepping      (trc_stp routine) 
    3535   USE dtadyn          ! Lecture and interpolation of the dynamical fields 
    36    USE stpctl          ! time stepping control            (stp_ctl routine) 
    3736   !              ! I/O & MPP 
    3837   USE iom             ! I/O library 
     
    4645   USE timing          ! Timing 
    4746   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    48    USE lbcnfd, ONLY: isendto, nsndto 
     47   USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 
    4948 
    5049   USE trc 
    5150   USE trcnam 
    5251   USE trcrst 
     52   USE diaptr         ! Need to initialise this as some variables are used in if statements later 
    5353 
    5454   IMPLICIT NONE 
     
    6161   !!---------------------------------------------------------------------- 
    6262   !! NEMO/OFF 3.3 , NEMO Consortium (2010) 
    63    !! $Id: nemogcm.F90 2528 2010-12-27 17:33:53Z rblod $ 
     63   !! $Id$ 
    6464   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6565   !!---------------------------------------------------------------------- 
     
    9494      istp = nit000 
    9595      !  
    96       CALL iom_init( "nemo" )            ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 
     96      CALL iom_init( cxios_context )            ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 
    9797      !  
    9898      DO WHILE ( istp <= nitend .AND. nstop == 0 )    ! time stepping 
     
    107107      END DO 
    108108#if defined key_iomput 
    109       CALL iom_context_finalize( "nemo" ) ! needed for XIOS+AGRIF 
     109      CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF 
    110110#endif 
    111111 
     
    142142      INTEGER ::   ilocal_comm   ! local integer 
    143143      INTEGER ::   ios 
     144      LOGICAL ::   llexist 
    144145      CHARACTER(len=80), DIMENSION(16) ::   cltxt 
    145146      !! 
     
    148149         &             nn_bench, nn_timing, nn_diacfl 
    149150      NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, & 
    150          &             jpizoom, jpjzoom, jperio 
     151         &             jpizoom, jpjzoom, jperio, ln_use_jattr 
    151152      !!---------------------------------------------------------------------- 
    152153      cltxt = '' 
     154      cxios_context = 'nemo' 
    153155      ! 
    154156      !                             ! Open reference namelist and configuration namelist files 
     
    180182      !                             !--------------------------------------------! 
    181183#if defined key_iomput 
    182       CALL  xios_initialize( "nemo",return_comm=ilocal_comm ) 
    183       narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection 
     184      CALL  xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm ) 
     185      narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection 
    184186#else 
    185187      ilocal_comm = 0 
    186       narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop )                ! Nodes selection (control print return in cltxt) 
     188      narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop )                ! Nodes selection (control print return in cltxt) 
    187189#endif 
    188190 
     
    232234         WRITE(numout,*) '                       NEMO team' 
    233235         WRITE(numout,*) '            Ocean General Circulation Model' 
    234          WRITE(numout,*) '                  version 3.5  (2012) ' 
     236         WRITE(numout,*) '                  version 3.6  (2015) ' 
    235237         WRITE(numout,*) 
    236238         WRITE(numout,*) 
     
    267269      IF( lk_c1d        )   CALL     c1d_init   ! 1D column configuration 
    268270                            CALL     dom_cfg    ! Domain configuration 
    269                             CALL     dom_init   ! Domain 
     271      ! 
     272      INQUIRE( FILE='coordinates.nc', EXIST = llexist )   ! Check if coordinate file exist 
     273      ! 
     274      IF( llexist )  THEN  ;  CALL  dom_init   !  compute the grid from coordinates and bathymetry 
     275      ELSE                 ;  CALL  dom_rea    !  read grid from the meskmask 
     276      ENDIF 
    270277                            CALL  istate_init   ! ocean initial state (Dynamics and tracers) 
    271278 
     
    274281      IF( ln_ctl        )   CALL prt_ctl_init   ! Print control 
    275282 
    276       !                                     ! Ocean physics 
    277283                            CALL     sbc_init   ! Forcings : surface module 
     284 
    278285#if ! defined key_degrad 
    279286                            CALL ldf_tra_init   ! Lateral ocean tracer physics 
     
    281288      IF( lk_ldfslp )       CALL ldf_slp_init   ! slope of lateral mixing 
    282289 
    283       !                                     ! Active tracers 
    284290                            CALL tra_qsr_init   ! penetrative solar radiation qsr 
    285291      IF( lk_trabbl     )   CALL tra_bbl_init   ! advective (and/or diffusive) bottom boundary layer scheme 
    286292 
    287                             CALL trc_nam_run  ! Needed to get restart parameters for passive tracers 
    288       IF( ln_rsttr ) THEN 
    289         neuler = 1   ! Set time-step indicator at nit000 (leap-frog) 
    290         CALL trc_rst_cal( nit000, 'READ' )   ! calendar 
    291       ELSE 
    292         neuler = 0                  ! Set time-step indicator at nit000 (euler) 
    293         CALL day_init               ! set calendar 
    294       ENDIF 
    295       !                                     ! Dynamics 
     293                            CALL trc_nam_run    ! Needed to get restart parameters for passive tracers 
     294                            CALL trc_rst_cal( nit000, 'READ' )   ! calendar 
    296295                            CALL dta_dyn_init   ! Initialization for the dynamics 
    297296 
    298       !                                     ! Passive tracers 
    299297                            CALL     trc_init   ! Passive tracers initialization 
    300  
    301       IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA 
     298                            CALL dia_ptr_init   ! Initialise diaptr as some variables are used  
     299      !                                         ! in various advection and diffusion routines 
     300      IF(lwp) WRITE(numout,cform_aaa)           ! Flag AAAAAAA 
    302301      ! 
    303302      IF( nn_timing == 1 )  CALL timing_stop( 'nemo_init') 
     
    354353         WRITE(numout,*) '      left bottom j index of the zoom (in data domain) jpizoom = ', jpjzoom 
    355354         WRITE(numout,*) '      lateral cond. type (between 0 and 6) jperio = ', jperio    
     355         WRITE(numout,*) '      use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 
    356356      ENDIF 
    357357      !                             ! Parameter control 
     
    589589      !!---------------------------------------------------------------------- 
    590590      !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) 
    591       !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC)  
     591      !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. 
     592      !Mocavero, CMCC)  
    592593      !!---------------------------------------------------------------------- 
    593594 
     
    612613          !loop over the other north-fold processes to find the processes 
    613614          !managing the points belonging to the sxT-dxT range 
    614           DO jn = jpnij - jpni +1, jpnij 
    615              IF ( njmppt(jn) == njmppmax ) THEN 
     615 
     616          DO jn = 1, jpni 
    616617                !sxT is the first point (in the global domain) of the jn 
    617618                !process 
    618                 sxT = nimppt(jn) 
     619                sxT = nfiimpp(jn, jpnj) 
    619620                !dxT is the last point (in the global domain) of the jn 
    620621                !process 
    621                 dxT = nimppt(jn) + nlcit(jn) - 1 
     622                dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1 
    622623                IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 
    623624                   nsndto = nsndto + 1 
    624                    isendto(nsndto) = jn 
    625                 ELSEIF ((sxM .le. sxT) .AND. (dxM .gt. dxT)) THEN 
     625                     isendto(nsndto) = jn 
     626                ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN 
    626627                   nsndto = nsndto + 1 
    627                    isendto(nsndto) = jn 
     628                     isendto(nsndto) = jn 
    628629                ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN 
    629630                   nsndto = nsndto + 1 
    630                    isendto(nsndto) = jn 
     631                     isendto(nsndto) = jn 
    631632                END IF 
    632              END IF 
    633633          END DO 
     634          nfsloop = 1 
     635          nfeloop = nlci 
     636          DO jn = 2,jpni-1 
     637           IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN 
     638              IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN 
     639                 nfsloop = nldi 
     640              ENDIF 
     641              IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN 
     642                 nfeloop = nlei 
     643              ENDIF 
     644           ENDIF 
     645        END DO 
     646 
    634647      ENDIF 
    635648      l_north_nogather = .TRUE. 
    636  
    637649   END SUBROUTINE nemo_northcomms 
    638650#else 
     
    641653   END SUBROUTINE nemo_northcomms 
    642654#endif 
     655 
     656   SUBROUTINE istate_init 
     657      !!---------------------------------------------------------------------- 
     658      !!                   ***  ROUTINE istate_init  *** 
     659      !! 
     660      !! ** Purpose :   Initialization to zero of the dynamics and tracers. 
     661      !!---------------------------------------------------------------------- 
     662      ! 
     663      !     now fields         !     after fields      ! 
     664      un   (:,:,:)   = 0._wp   ;   ua(:,:,:) = 0._wp   ! 
     665      vn   (:,:,:)   = 0._wp   ;   va(:,:,:) = 0._wp   ! 
     666      wn   (:,:,:)   = 0._wp   !                       ! 
     667      hdivn(:,:,:)   = 0._wp   !                       ! 
     668      tsn  (:,:,:,:) = 0._wp   !                       ! 
     669      ! 
     670      rhd  (:,:,:) = 0.e0 
     671      rhop (:,:,:) = 0.e0 
     672      rn2  (:,:,:) = 0.e0 
     673      ! 
     674   END SUBROUTINE istate_init 
     675 
     676   SUBROUTINE stp_ctl( kt, kindic ) 
     677      !!---------------------------------------------------------------------- 
     678      !!                    ***  ROUTINE stp_ctl  *** 
     679      !! 
     680      !! ** Purpose :   Control the run 
     681      !! 
     682      !! ** Method  : - Save the time step in numstp 
     683      !! 
     684      !! ** Actions :   'time.step' file containing the last ocean time-step 
     685      !!---------------------------------------------------------------------- 
     686      INTEGER, INTENT(in   ) ::   kt      ! ocean time-step index 
     687      INTEGER, INTENT(inout) ::   kindic  ! indicator of solver convergence 
     688      !!---------------------------------------------------------------------- 
     689      ! 
     690      IF( kt == nit000 .AND. lwp ) THEN 
     691         WRITE(numout,*) 
     692         WRITE(numout,*) 'stp_ctl : time-stepping control' 
     693         WRITE(numout,*) '~~~~~~~' 
     694         ! open time.step file 
     695         CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     696      ENDIF 
     697      ! 
     698      IF(lwp) WRITE ( numstp, '(1x, i8)' )   kt      !* save the current time step in numstp 
     699      IF(lwp) REWIND( numstp )                       ! -------------------------- 
     700      ! 
     701   END SUBROUTINE stp_ctl 
    643702   !!====================================================================== 
    644703END MODULE nemogcm 
Note: See TracChangeset for help on using the changeset viewer.