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 4792 for branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90 – NEMO

Ignore:
Timestamp:
2014-09-26T13:04:47+02:00 (10 years ago)
Author:
jamesharle
Message:

Updates to code after first successful test + merge with HEAD of trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r4354 r4792  
    8686   USE sbctide, ONLY: lk_tide 
    8787   USE crsini          ! initialise grid coarsening utility 
    88    USE lbcnfd, ONLY: isendto, nsndto ! Setup of north fold exchanges  
     88   USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges  
    8989 
    9090   IMPLICIT NONE 
     
    240240      CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
    241241      CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
    242       CALL ctl_opn( numond, 'output.namelist.dyn', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 ) 
    243242      ! 
    244243      REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints & Benchmark 
     
    249248      READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 ) 
    250249902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. ) 
    251       WRITE( numond, namctl ) 
    252250 
    253251      ! 
     
    259257      READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 
    260258904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )    
    261       WRITE( numond, namcfg ) 
    262259 
    263260! Force values for AGRIF zoom (cf. agrif_user.F90) 
     
    279276      !                             !--------------------------------------------! 
    280277      !                             !  set communicator & select the local node  ! 
     278      !                             !  NB: mynode also opens output.namelist.dyn ! 
     279      !                             !      on unit number numond on first proc   ! 
    281280      !                             !--------------------------------------------! 
    282281#if defined key_iomput 
     
    303302      narea = narea + 1                                     ! mynode return the rank of proc (0 --> jpnij -1 ) 
    304303 
     304      lwm = (narea == 1)                                    ! control of output namelists 
    305305      lwp = (narea == 1) .OR. ln_ctl                        ! control of all listing output print 
     306 
     307      IF(lwm) THEN 
     308         ! write merged namelists from earlier to output namelist now that the 
     309         ! file has been opened in call to mynode. nammpp has already been 
     310         ! written in mynode (if lk_mpp_mpi) 
     311         WRITE( numond, namctl ) 
     312         WRITE( numond, namcfg ) 
     313      ENDIF 
    306314 
    307315      ! If dimensions of processor grid weren't specified in the namelist file 
     
    560568      ENDIF 
    561569      ! 
    562       IF( lk_c1d .AND. .NOT.lk_iomput )   CALL ctl_stop( 'nemo_ctl: The 1D configuration must be used ',   & 
    563          &                                               'with the IOM Input/Output manager. '         ,   & 
    564          &                                               'Compile with key_iomput enabled' ) 
    565       ! 
    566570      IF( 1_wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ',  & 
    567571         &                                               'f2003 standard. '                              ,  & 
     
    586590      IF( numnam_ref      /= -1 )   CLOSE( numnam_ref      )   ! oce reference namelist 
    587591      IF( numnam_cfg      /= -1 )   CLOSE( numnam_cfg      )   ! oce configuration namelist 
    588       IF( numond          /= -1 )   CLOSE( numond          )   ! oce output namelist 
     592      IF( lwm.AND.numond  /= -1 )   CLOSE( numond          )   ! oce output namelist 
    589593      IF( numnam_ice_ref  /= -1 )   CLOSE( numnam_ice_ref  )   ! ice reference namelist 
    590594      IF( numnam_ice_cfg  /= -1 )   CLOSE( numnam_ice_cfg  )   ! ice configuration namelist 
    591       IF( numoni          /= -1 )   CLOSE( numoni          )   ! ice output namelist 
     595      IF( lwm.AND.numoni  /= -1 )   CLOSE( numoni          )   ! ice output namelist 
    592596      IF( numevo_ice      /= -1 )   CLOSE( numevo_ice      )   ! ice variables (temp. evolution) 
    593597      IF( numout          /=  6 )   CLOSE( numout          )   ! standard model output file 
     
    795799          !loop over the other north-fold processes to find the processes 
    796800          !managing the points belonging to the sxT-dxT range 
    797           DO jn = jpnij - jpni +1, jpnij 
    798              IF ( njmppt(jn) == njmppmax ) THEN 
     801   
     802          DO jn = 1, jpni 
    799803                !sxT is the first point (in the global domain) of the jn 
    800804                !process 
    801                 sxT = nimppt(jn) 
     805                sxT = nfiimpp(jn, jpnj) 
    802806                !dxT is the last point (in the global domain) of the jn 
    803807                !process 
    804                 dxT = nimppt(jn) + nlcit(jn) - 1 
     808                dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1 
    805809                IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 
    806810                   nsndto = nsndto + 1 
    807                    isendto(nsndto) = jn 
    808                 ELSEIF ((sxM .le. sxT) .AND. (dxM .gt. dxT)) THEN 
     811                     isendto(nsndto) = jn 
     812                ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN 
    809813                   nsndto = nsndto + 1 
    810                    isendto(nsndto) = jn 
     814                     isendto(nsndto) = jn 
    811815                ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN 
    812816                   nsndto = nsndto + 1 
    813                    isendto(nsndto) = jn 
     817                     isendto(nsndto) = jn 
    814818                END IF 
    815              END IF 
    816819          END DO 
     820          nfsloop = 1 
     821          nfeloop = nlci 
     822          DO jn = 2,jpni-1 
     823           IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN 
     824              IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN 
     825                 nfsloop = nldi 
     826              ENDIF 
     827              IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN 
     828                 nfeloop = nlei 
     829              ENDIF 
     830           ENDIF 
     831        END DO 
     832 
    817833      ENDIF 
    818834      l_north_nogather = .TRUE. 
Note: See TracChangeset for help on using the changeset viewer.