Changeset 11624 for NEMO/branches/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/OCE/LBC

Timestamp:

2019-10-01T15:07:45+02:00 (5 years ago)

Author:

acc

Message:

Branch 2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles. Substantive changes required to replace all namelists with internal files. These are the key changes only; to compile and run tests all REWIND and CLOSE operations on the (no longer) units have to be removed. These changes affect many more files but can be scripted so are not included here in order to make a later merge easier. The scripts used to prepare code for testing are included on: wiki:2019WP/ENHANCE-04_AndrewC-reporting/Internal_Namelists. With these additional changes this code passes most SETTE tests but the AGRIF preprocessor does not currently accept the new allocatable character strings. To be investigated.

File:

• NEMO/branches/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/OCE/LBC/lib_mpp.F90 (modified) (4 diffs)

NEMO/branches/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/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
    !!----------------------------------------------------------------------
    !!----------------------------------------------------------------------
@@ -57 +58 @@
    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
@@ -1068 +1069 @@
 
    !!----------------------------------------------------------------------
-   !!   ctl_stop, ctl_warn, get_unit, ctl_opn, ctl_nam   routines
+   !!   ctl_stop, ctl_warn, get_unit, ctl_opn, ctl_nam, load_nml   routines
    !!----------------------------------------------------------------------
 
@@ -1279 +1280 @@
    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
+      INTEGER, INTENT(IN)                          :: kout
+      LOGICAL, INTENT(IN)                          :: ldwp
+      INTEGER                                      :: itot, iun, iltc, inl, ios
+      !
+      ! Check if the namelist buffer has already been allocated. Return if it has.
+      !
+      IF ( ALLOCATED( cdnambuff ) ) RETURN
+      !
+      ! 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
+      !
+      ALLOCATE( CHARACTER(LEN=itot) :: cdnambuff )
+      WRITE(*,*) 'ALLOCATED ', 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)' ) NEW_LINE('A')
+          itot = itot + inl + 1
+       ENDIF
+      ENDIF
+      GOTO 30
+  40  CONTINUE
+      WRITE(*,*) 'ASSIGNED ',itot - 1
+      !
+      ! Close namelist file
+      !
+      CLOSE(iun)
+      !write(*,'(32A)') cdnambuff
+  END SUBROUTINE load_nml
+
+
    !!----------------------------------------------------------------------
 END MODULE lib_mpp