Changeset 12928 for NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/LBC/lib_mpp.F90

Timestamp:

2020-05-14T21:46:00+02:00 (4 years ago)

Author:

smueller

Message:

Synchronizing with ^{/NEMO/trunk@12925 (ticket #2170)}

Location:

NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser

Files:

• . (modified) (1 prop)
• src/OCE/LBC/lib_mpp.F90 (modified) (13 diffs)

NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser

@@ -6 +6 @@
 ^/vendors/FCM@HEAD            ext/FCM
 ^/vendors/IOIPSL@HEAD         ext/IOIPSL
+
+# SETTE
+^/utils/CI/sette@HEAD         sette

@@ -6 +6 @@
 ^/vendors/FCM@HEAD            ext/FCM
 ^/vendors/IOIPSL@HEAD         ext/IOIPSL
+
+# SETTE
+^/utils/CI/sette@HEAD         sette

NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/LBC/lib_mpp.F90

@@ -32 +32 @@
    !!   ctl_opn       : Open file and check if required file is available.
    !!   ctl_nam       : Prints informations when an error occurs while reading a namelist
+   !!   load_nml      : Read, condense and buffer namelist file into character array for use as an internal file
    !!----------------------------------------------------------------------
    !!----------------------------------------------------------------------
@@ -50 +51 @@
    !!   mpp_ini_north : initialisation of north fold
    !!   mpp_lbc_north_icb : alternative to mpp_nfd for extra outer halo with icebergs
+   !!   mpp_bcast_nml : broadcast/receive namelist character buffer from reading process to all others
    !!----------------------------------------------------------------------
    USE dom_oce        ! ocean space and time domain
@@ -57 +59 @@
    PRIVATE
    !
-   PUBLIC   ctl_stop, ctl_warn, ctl_opn, ctl_nam
+   PUBLIC   ctl_stop, ctl_warn, ctl_opn, ctl_nam, load_nml
    PUBLIC   mpp_start, mppstop, mppsync, mpp_comm_free
    PUBLIC   mpp_ini_north
@@ -66 +68 @@
    PUBLIC   mppsend, mpprecv                          ! needed by TAM and ICB routines
    PUBLIC   mpp_report
+   PUBLIC   mpp_bcast_nml
    PUBLIC   tic_tac
 #if ! defined key_mpp_mpi
@@ -139 +142 @@
    INTEGER, PUBLIC                               ::   ncom_stp = 0                 !: copy of time step # istp
    INTEGER, PUBLIC                               ::   ncom_fsbc = 1                !: copy of sbc time step # nn_fsbc
-   INTEGER, PUBLIC                               ::   ncom_dttrc = 1               !: copy of top time step # nn_dttrc
    INTEGER, PUBLIC                               ::   ncom_freq                    !: frequency of comm diagnostic
    INTEGER, PUBLIC , DIMENSION(:,:), ALLOCATABLE ::   ncomm_sequence               !: size of communicated arrays (halos)
@@ -170 +172 @@
    LOGICAL, PUBLIC ::   l_north_nogather = .FALSE.  !: internal control of northfold comms
    
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -398 +402 @@
 # if defined key_mpi2
       IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.)
-      CALL  mpi_allreduce( y_in(:), todelay(idvar)%y1d(:), isz, MPI_DOUBLE_COMPLEX, mpi_sumdd, ilocalcomm, ndelayid(idvar), ierr )
+      CALL  mpi_allreduce( y_in(:), todelay(idvar)%y1d(:), isz, MPI_DOUBLE_COMPLEX, mpi_sumdd, ilocalcomm, ierr )
+      ndelayid(idvar) = 1
       IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.)
 # else
@@ -465 +470 @@
 # if defined key_mpi2
       IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.)
-      CALL  mpi_allreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_DOUBLE_PRECISION, mpi_max, ilocalcomm, ndelayid(idvar), ierr )
+      CALL  mpi_allreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_DOUBLE_PRECISION, mpi_max, ilocalcomm, ierr )
+      ndelayid(idvar) = 1
       IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.)
 # else
@@ -499 +505 @@
 #endif
    END SUBROUTINE mpp_delay_rcv
+
+   SUBROUTINE mpp_bcast_nml( cdnambuff , kleng )
+      CHARACTER(LEN=:)    , ALLOCATABLE, INTENT(INOUT) :: cdnambuff
+      INTEGER                          , INTENT(INOUT) :: kleng
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_bcast_nml  ***
+      !!
+      !! ** Purpose :   broadcast namelist character buffer
+      !!
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER ::   iflag
+      !!----------------------------------------------------------------------
+      !
+#if defined key_mpp_mpi
+      call MPI_BCAST(kleng, 1, MPI_INT, 0, mpi_comm_oce, iflag)
+      call MPI_BARRIER(mpi_comm_oce, iflag)
+!$AGRIF_DO_NOT_TREAT
+      IF ( .NOT. ALLOCATED(cdnambuff) ) ALLOCATE( CHARACTER(LEN=kleng) :: cdnambuff )
+!$AGRIF_END_DO_NOT_TREAT
+      call MPI_BCAST(cdnambuff, kleng, MPI_CHARACTER, 0, mpi_comm_oce, iflag)
+      call MPI_BARRIER(mpi_comm_oce, iflag)
+#endif
+      !
+   END SUBROUTINE mpp_bcast_nml
 
    
@@ -921 +952 @@
       !
       ! find the smallest common frequency: default = frequency product, if multiple, choose the larger of the 2 frequency
-      IF( ncom_dttrc /= 1 )   CALL ctl_stop( 'STOP', 'mpp_report, ncom_dttrc /= 1 not coded...' ) 
       ncom_freq = ncom_fsbc
       !
@@ -1068 +1098 @@
 
    !!----------------------------------------------------------------------
-   !!   ctl_stop, ctl_warn, get_unit, ctl_opn, ctl_nam   routines
+   !!   ctl_stop, ctl_warn, get_unit, ctl_opn, ctl_nam, load_nml   routines
    !!----------------------------------------------------------------------
 
@@ -1204 +1234 @@
          &  OPEN(UNIT=knum,FILE='NUL', FORM=cdform, ACCESS=cdacce, STATUS=cdstat                      , ERR=100, IOSTAT=iost )   
       IF( iost == 0 ) THEN
-         IF(ldwp) THEN
+         IF(ldwp .AND. kout > 0) THEN
             WRITE(kout,*) '     file   : ', TRIM(clfile),' open ok'
             WRITE(kout,*) '     unit   = ', knum
@@ -1279 +1309 @@
    END FUNCTION get_unit
 
+   SUBROUTINE load_nml( cdnambuff , cdnamfile, kout, ldwp)
+      CHARACTER(LEN=:)    , ALLOCATABLE, INTENT(INOUT) :: cdnambuff
+      CHARACTER(LEN=*), INTENT(IN )                :: cdnamfile
+      CHARACTER(LEN=256)                           :: chline
+      CHARACTER(LEN=1)                             :: csp
+      INTEGER, INTENT(IN)                          :: kout
+      LOGICAL, INTENT(IN)                          :: ldwp  !: .true. only for the root broadcaster
+      INTEGER                                      :: itot, iun, iltc, inl, ios, itotsav
+      !
+      !csp = NEW_LINE('A')
+      ! a new line character is the best seperator but some systems (e.g.Cray)
+      ! seem to terminate namelist reads from internal files early if they 
+      ! encounter new-lines. Use a single space for safety.
+      csp = ' '
+      !
+      ! Check if the namelist buffer has already been allocated. Return if it has.
+      !
+      IF ( ALLOCATED( cdnambuff ) ) RETURN
+      IF( ldwp ) THEN
+         !
+         ! Open namelist file
+         !
+         CALL ctl_opn( iun, cdnamfile, 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, kout, ldwp )
+         !
+         ! First pass: count characters excluding comments and trimable white space
+         !
+         itot=0
+     10  READ(iun,'(A256)',END=20,ERR=20) chline
+         iltc = LEN_TRIM(chline)
+         IF ( iltc.GT.0 ) THEN
+          inl = INDEX(chline, '!') 
+          IF( inl.eq.0 ) THEN
+           itot = itot + iltc + 1                                ! +1 for the newline character
+          ELSEIF( inl.GT.0 .AND. LEN_TRIM( chline(1:inl-1) ).GT.0 ) THEN
+           itot = itot + inl                                  !  includes +1 for the newline character
+          ENDIF
+         ENDIF
+         GOTO 10
+     20  CONTINUE
+         !
+         ! Allocate text cdnambuff for condensed namelist
+         !
+!$AGRIF_DO_NOT_TREAT
+         ALLOCATE( CHARACTER(LEN=itot) :: cdnambuff )
+!$AGRIF_END_DO_NOT_TREAT
+         itotsav = itot
+         !
+         ! Second pass: read and transfer pruned characters into cdnambuff
+         !
+         REWIND(iun)
+         itot=1
+     30  READ(iun,'(A256)',END=40,ERR=40) chline
+         iltc = LEN_TRIM(chline)
+         IF ( iltc.GT.0 ) THEN
+          inl = INDEX(chline, '!')
+          IF( inl.eq.0 ) THEN
+           inl = iltc
+          ELSE
+           inl = inl - 1
+          ENDIF
+          IF( inl.GT.0 .AND. LEN_TRIM( chline(1:inl) ).GT.0 ) THEN
+             cdnambuff(itot:itot+inl-1) = chline(1:inl)
+             WRITE( cdnambuff(itot+inl:itot+inl), '(a)' ) csp
+             itot = itot + inl + 1
+          ENDIF
+         ENDIF
+         GOTO 30
+     40  CONTINUE
+         itot = itot - 1
+         IF( itotsav .NE. itot ) WRITE(*,*) 'WARNING in load_nml. Allocated ',itotsav,' for read buffer; but used ',itot
+         !
+         ! Close namelist file
+         !
+         CLOSE(iun)
+         !write(*,'(32A)') cdnambuff
+      ENDIF
+#if defined key_mpp_mpi
+      CALL mpp_bcast_nml( cdnambuff, itot )
+#endif
+  END SUBROUTINE load_nml
+
+
    !!----------------------------------------------------------------------
 END MODULE lib_mpp

@@ -6 +6 @@
 ^/vendors/FCM@HEAD            ext/FCM
 ^/vendors/IOIPSL@HEAD         ext/IOIPSL
+
+# SETTE
+^/utils/CI/sette@HEAD         sette