Ignore:
Timestamp:
2015-07-15T17:46:12+02:00 (5 years ago)
Author:
andrewryan
Message:

merged in latest version of trunk alongside changes to SAO_SRC to be compatible with latest OBS

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90

    • Property svn:keywords set to Id
    r5034 r5600  
    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 
     
    6261   !!---------------------------------------------------------------------- 
    6362   !! NEMO/OFF 3.3 , NEMO Consortium (2010) 
    64    !! $Id: nemogcm.F90 2528 2010-12-27 17:33:53Z rblod $ 
     63   !! $Id$ 
    6564   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6665   !!---------------------------------------------------------------------- 
     
    9594      istp = nit000 
    9695      !  
    97       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) 
    9897      !  
    9998      DO WHILE ( istp <= nitend .AND. nstop == 0 )    ! time stepping 
     
    108107      END DO 
    109108#if defined key_iomput 
    110       CALL iom_context_finalize( "nemo" ) ! needed for XIOS+AGRIF 
     109      CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF 
    111110#endif 
    112111 
     
    143142      INTEGER ::   ilocal_comm   ! local integer 
    144143      INTEGER ::   ios 
     144      LOGICAL ::   llexist 
    145145      CHARACTER(len=80), DIMENSION(16) ::   cltxt 
    146146      !! 
     
    149149         &             nn_bench, nn_timing 
    150150      NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, & 
    151          &             jpizoom, jpjzoom, jperio 
     151         &             jpizoom, jpjzoom, jperio, ln_use_jattr 
    152152      !!---------------------------------------------------------------------- 
    153153      cltxt = '' 
     154      cxios_context = 'nemo' 
    154155      ! 
    155156      !                             ! Open reference namelist and configuration namelist files 
     
    181182      !                             !--------------------------------------------! 
    182183#if defined key_iomput 
    183       CALL  xios_initialize( "nemo",return_comm=ilocal_comm ) 
    184       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 
    185186#else 
    186187      ilocal_comm = 0 
    187       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) 
    188189#endif 
    189190 
     
    233234         WRITE(numout,*) '                       NEMO team' 
    234235         WRITE(numout,*) '            Ocean General Circulation Model' 
    235          WRITE(numout,*) '                  version 3.5  (2012) ' 
     236         WRITE(numout,*) '                  version 3.6  (2015) ' 
    236237         WRITE(numout,*) 
    237238         WRITE(numout,*) 
     
    268269      IF( lk_c1d        )   CALL     c1d_init   ! 1D column configuration 
    269270                            CALL     dom_cfg    ! Domain configuration 
    270                             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 
    271277                            CALL  istate_init   ! ocean initial state (Dynamics and tracers) 
    272278 
     
    275281      IF( ln_ctl        )   CALL prt_ctl_init   ! Print control 
    276282 
    277       !                                     ! Ocean physics 
    278283                            CALL     sbc_init   ! Forcings : surface module 
     284 
    279285#if ! defined key_degrad 
    280286                            CALL ldf_tra_init   ! Lateral ocean tracer physics 
     
    282288      IF( lk_ldfslp )       CALL ldf_slp_init   ! slope of lateral mixing 
    283289 
    284       !                                     ! Active tracers 
    285290                            CALL tra_qsr_init   ! penetrative solar radiation qsr 
    286291      IF( lk_trabbl     )   CALL tra_bbl_init   ! advective (and/or diffusive) bottom boundary layer scheme 
    287292 
    288                             CALL trc_nam_run  ! Needed to get restart parameters for passive tracers 
    289       IF( ln_rsttr ) THEN 
    290         neuler = 1   ! Set time-step indicator at nit000 (leap-frog) 
    291         CALL trc_rst_cal( nit000, 'READ' )   ! calendar 
    292       ELSE 
    293         neuler = 0                  ! Set time-step indicator at nit000 (euler) 
    294         CALL day_init               ! set calendar 
    295       ENDIF 
    296       !                                     ! Dynamics 
     293                            CALL trc_nam_run    ! Needed to get restart parameters for passive tracers 
     294                            CALL trc_rst_cal( nit000, 'READ' )   ! calendar 
    297295                            CALL dta_dyn_init   ! Initialization for the dynamics 
    298296 
    299       !                                     ! Passive tracers 
    300297                            CALL     trc_init   ! Passive tracers initialization 
    301       ! 
    302       ! Initialise diaptr as some variables are used in if statements later (in 
    303       ! various advection and diffusion routines. 
    304                             CALL dia_ptr_init 
    305       ! 
    306       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 
    307301      ! 
    308302      IF( nn_timing == 1 )  CALL timing_stop( 'nemo_init') 
     
    359353         WRITE(numout,*) '      left bottom j index of the zoom (in data domain) jpizoom = ', jpjzoom 
    360354         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 
    361356      ENDIF 
    362357      !                             ! Parameter control 
     
    594589      !!---------------------------------------------------------------------- 
    595590      !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) 
    596       !!    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)  
    597593      !!---------------------------------------------------------------------- 
    598594 
     
    617613          !loop over the other north-fold processes to find the processes 
    618614          !managing the points belonging to the sxT-dxT range 
    619           DO jn = jpnij - jpni +1, jpnij 
    620              IF ( njmppt(jn) == njmppmax ) THEN 
     615 
     616          DO jn = 1, jpni 
    621617                !sxT is the first point (in the global domain) of the jn 
    622618                !process 
    623                 sxT = nimppt(jn) 
     619                sxT = nfiimpp(jn, jpnj) 
    624620                !dxT is the last point (in the global domain) of the jn 
    625621                !process 
    626                 dxT = nimppt(jn) + nlcit(jn) - 1 
     622                dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1 
    627623                IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 
    628624                   nsndto = nsndto + 1 
    629                    isendto(nsndto) = jn 
    630                 ELSEIF ((sxM .le. sxT) .AND. (dxM .gt. dxT)) THEN 
     625                     isendto(nsndto) = jn 
     626                ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN 
    631627                   nsndto = nsndto + 1 
    632                    isendto(nsndto) = jn 
     628                     isendto(nsndto) = jn 
    633629                ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN 
    634630                   nsndto = nsndto + 1 
    635                    isendto(nsndto) = jn 
     631                     isendto(nsndto) = jn 
    636632                END IF 
    637              END IF 
    638633          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 
    639647      ENDIF 
    640648      l_north_nogather = .TRUE. 
    641  
    642649   END SUBROUTINE nemo_northcomms 
    643650#else 
     
    646653   END SUBROUTINE nemo_northcomms 
    647654#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 
    648702   !!====================================================================== 
    649703END MODULE nemogcm 
Note: See TracChangeset for help on using the changeset viewer.