Back to home page

MITgcm
 
 

    

File indexing completed on 2022-04-14 05:09:20 UTC

view on githubraw file Latest commit 3d93c0a0 on 2022-04-13 15:21:38 UTC
20bcbe789b Patr*0001 #include "EXF_OPTIONS.h"
                0002 
3e6ce1cd50 Jean*0003 CBOP
                0004 C !ROUTINE: EXF_INTERP_READ
                0005 C !INTERFACE:
                0006        SUBROUTINE EXF_INTERP_READ(
                0007      I                infile, filePrec,
                0008      O                arrayin,
                0009      I                irecord, nx_in, ny_in, myThid )
20bcbe789b Patr*0010 
3e6ce1cd50 Jean*0011 C !DESCRIPTION:
20bcbe789b Patr*0012 
3e6ce1cd50 Jean*0013 C !USES:
                0014       IMPLICIT NONE
20bcbe789b Patr*0015 
3e6ce1cd50 Jean*0016 C Global variables / common blocks
20bcbe789b Patr*0017 #include "SIZE.h"
                0018 #include "EEPARAMS.h"
473d957599 Jean*0019 #include "PARAMS.h"
                0020 #include "EXF_INTERP_SIZE.h"
3e6ce1cd50 Jean*0021 #include "EXF_PARAM.h"
20bcbe789b Patr*0022 #ifdef ALLOW_USE_MPI
                0023 # include "EESUPPORT.h"
                0024 #endif /* ALLOW_USE_MPI */
3e6ce1cd50 Jean*0025 
                0026 C !INPUT/OUTPUT PARAMETERS:
                0027 C  infile      (string)  :: name of the binary input file (direct access)
                0028 C  filePrec    (integer) :: number of bits per word in file (32 or 64)
                0029 C  arrayin     ( _RL )   :: array to read file into
                0030 C  irecord     (integer) :: record number to read
                0031 C  nx_in,ny_in (integer) :: size in x & y direction of input file to read
                0032 C  myThid      (integer) :: My Thread Id number
                0033       CHARACTER*(*) infile
                0034       INTEGER       filePrec, irecord, nx_in, ny_in
                0035        _RL          arrayin( -1:nx_in+2 , -1:ny_in+2 )
                0036       INTEGER       myThid
                0037 CEOP
                0038 
                0039 C !FUNCTIONS
6deff2792b Mart*0040       INTEGER  ILNBLNK
3e6ce1cd50 Jean*0041       INTEGER MDS_RECLEN
                0042       LOGICAL MASTER_CPU_IO
6deff2792b Mart*0043       EXTERNAL ILNBLNK
3e6ce1cd50 Jean*0044       EXTERNAL MDS_RECLEN
                0045       EXTERNAL MASTER_CPU_IO
                0046 
                0047 C !LOCAL VARIABLES
                0048       INTEGER  i, j
6deff2792b Mart*0049       INTEGER  ioUnit, length_of_rec, IL
                0050       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0051       LOGICAL  exst
3e6ce1cd50 Jean*0052 #ifdef EXF_INTERP_USE_DYNALLOC
2e7833c3c9 Chri*0053 #ifdef EXF_IREAD_USE_GLOBAL_POINTER
                0054 C     When using threads the address of the local automatic array
3e6ce1cd50 Jean*0055 C     "buffer" is not visible to the other threads. So we create
2e7833c3c9 Chri*0056 C     a pointer to share that address here. This is presently
                0057 C     in an ifdef because it won't go through g77 and I'm not
                0058 C     currently sure what TAF would do with this.
82ff416a86 Dimi*0059       COMMON /EXF_IOPTR8/ glPtr8
                0060       REAL*8, POINTER :: glPtr8(:,:)
3e6ce1cd50 Jean*0061       COMMON /EXF_IOPTR4/ glPtr4
                0062       REAL*4, POINTER :: glPtr4(:,:)
                0063 
                0064       Real*8, target ::  buffer_r8(nx_in,ny_in)
                0065       Real*4, target ::  buffer_r4(nx_in,ny_in)
                0066 #else  /* ndef EXF_IREAD_USE_GLOBAL_POINTER */
                0067       Real*8   buffer_r8(nx_in,ny_in)
                0068       Real*4   buffer_r4(nx_in,ny_in)
                0069 #endif /* ndef EXF_IREAD_USE_GLOBAL_POINTER */
                0070 #else  /* ndef EXF_INTERP_USE_DYNALLOC */
                0071       Real*8   buffer_r8(exf_interp_bufferSize)
                0072       Real*4   buffer_r4(exf_interp_bufferSize)
                0073       COMMON /EXF_INTERP_BUFFER/ buffer_r8, buffer_r4
                0074       INTEGER ijs
                0075 #endif /* ndef EXF_INTERP_USE_DYNALLOC */
                0076 #ifdef ALLOW_USE_MPI
                0077       INTEGER  ierr
2e7833c3c9 Chri*0078 #endif
                0079 
3e6ce1cd50 Jean*0080 C--   Check for consistency:
                0081 #ifdef EXF_INTERP_USE_DYNALLOC
2e7833c3c9 Chri*0082 #ifndef EXF_IREAD_USE_GLOBAL_POINTER
3e6ce1cd50 Jean*0083 C     The CPP symbol EXF_IREAD_USE_GLOBAL_POINTER must be defined for the
                0084 C     case of nThreads > 1. Stop IF it isnt.
2e7833c3c9 Chri*0085       IF ( nThreads .GT. 1 ) THEN
3e6ce1cd50 Jean*0086       STOP
2e7833c3c9 Chri*0087      &'EXF_INTERP_READ: nThreads > 1 needs EXF_IREAD_USE_GLOBAL_POINTER'
                0088       ENDIF
                0089 #endif
3e6ce1cd50 Jean*0090 #else  /* ndef EXF_INTERP_USE_DYNALLOC */
f5ff5e99fd Dimi*0091 #ifdef EXF_IREAD_USE_GLOBAL_POINTER
3e6ce1cd50 Jean*0092       STOP
                0093      &'EXF_INTERP_READ: USE_GLOBAL_POINTER needs INTERP_USE_DYNALLOC'
f5ff5e99fd Dimi*0094 #endif
3e6ce1cd50 Jean*0095       IF ( nx_in*ny_in .GT. exf_interp_bufferSize ) THEN
                0096         STOP 'EXF_INTERP_READ: exf_interp_bufferSize too small'
                0097       ENDIF
                0098 #endif /* ndef EXF_INTERP_USE_DYNALLOC */
20bcbe789b Patr*0099 
3e6ce1cd50 Jean*0100 C--   before starting to read, wait for everyone to finish
                0101       _BARRIER
20bcbe789b Patr*0102 
3e6ce1cd50 Jean*0103 C---  read in input data
                0104 
                0105       IF ( MASTER_CPU_IO(myThid) ) THEN
                0106 C--   master thread of process 0, only, opens a global file
20bcbe789b Patr*0107 
6deff2792b Mart*0108         IL  = ILNBLNK( infile )
                0109         INQUIRE( file=infile, exist=exst )
                0110         IF (exst) THEN
4f63115f05 Jean*0111          IF ( debugLevel.GE.debLevB ) THEN
6deff2792b Mart*0112           WRITE(msgBuf,'(A,A)')
                0113      &         ' EXF_INTERP_READ: opening file: ',infile(1:IL)
                0114           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0115      &         SQUEEZE_RIGHT , myThid)
                0116          ENDIF
                0117         ELSE
                0118          WRITE(msgBuf,'(2A)')
                0119      &        ' EXF_INTERP_READ: filename: ', infile(1:IL)
                0120          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0121      &                       SQUEEZE_RIGHT , myThid)
                0122          CALL PRINT_ERROR( msgBuf, myThid )
                0123          WRITE(msgBuf,'(A)')
                0124      &        ' EXF_INTERP_READ: File does not exist'
                0125          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0126      &                       SQUEEZE_RIGHT , myThid)
                0127          CALL PRINT_ERROR( msgBuf, myThid )
                0128          STOP 'ABNORMAL END: S/R EXF_INTERP_READ'
                0129         ENDIF
                0130 
3e6ce1cd50 Jean*0131         CALL MDSFINDUNIT( ioUnit, myThid )
                0132         length_of_rec=MDS_RECLEN( filePrec, nx_in*ny_in, myThid )
3d93c0a01e Ou W*0133         OPEN( ioUnit, file=infile, status='old', _READONLY_ACTION
                0134      &       access='direct', recl=length_of_rec )
82ff416a86 Dimi*0135         IF ( filePrec .EQ. 32 ) THEN
3e6ce1cd50 Jean*0136 #ifdef EXF_INTERP_USE_DYNALLOC
                0137           READ(ioUnit,rec=irecord)  buffer_r4
                0138 #else
                0139           READ(ioUnit,rec=irecord) (buffer_r4(i),i=1,nx_in*ny_in)
                0140 #endif
82ff416a86 Dimi*0141 #ifdef _BYTESWAPIO
3e6ce1cd50 Jean*0142           CALL MDS_BYTESWAPR4(nx_in*ny_in,buffer_r4)
82ff416a86 Dimi*0143 #endif /* _BYTESWAPIO */
                0144         ELSE
3e6ce1cd50 Jean*0145 #ifdef EXF_INTERP_USE_DYNALLOC
                0146           READ(ioUnit,rec=irecord)  buffer_r8
                0147 #else
                0148           READ(ioUnit,rec=irecord) (buffer_r8(i),i=1,nx_in*ny_in)
                0149 #endif
82ff416a86 Dimi*0150 #ifdef _BYTESWAPIO
3e6ce1cd50 Jean*0151           CALL MDS_BYTESWAPR8(nx_in*ny_in,buffer_r8)
82ff416a86 Dimi*0152 #endif /* _BYTESWAPIO */
                0153         ENDIF
3e6ce1cd50 Jean*0154         CLOSE( ioUnit )
                0155 C--   end if MASTER_CPU_IO
                0156       ENDIF
20bcbe789b Patr*0157 
3e6ce1cd50 Jean*0158       _BEGIN_MASTER( myThid )
20bcbe789b Patr*0159 #ifdef ALLOW_USE_MPI
3e6ce1cd50 Jean*0160 C--   broadcast to all processes
631fe75038 Dimi*0161        IF ( useSingleCpuInput ) THEN
3e6ce1cd50 Jean*0162          IF ( filePrec .EQ. 32 ) THEN
                0163            CALL MPI_BCAST(buffer_r4,nx_in*ny_in,MPI_REAL,
                0164      &          0,MPI_COMM_MODEL,ierr)
                0165          ELSE
                0166            CALL MPI_BCAST(buffer_r8,nx_in*ny_in,MPI_DOUBLE_PRECISION,
                0167      &          0,MPI_COMM_MODEL,ierr)
                0168          ENDIF
                0169        ENDIF
20bcbe789b Patr*0170 #endif /* ALLOW_USE_MPI */
3e6ce1cd50 Jean*0171 
2e7833c3c9 Chri*0172 #ifdef EXF_IREAD_USE_GLOBAL_POINTER
82ff416a86 Dimi*0173        IF ( filePrec .EQ. 32 ) THEN
3e6ce1cd50 Jean*0174          glPtr4 => buffer_r4
82ff416a86 Dimi*0175        ELSE
3e6ce1cd50 Jean*0176          glPtr8 => buffer_r8
82ff416a86 Dimi*0177        ENDIF
2e7833c3c9 Chri*0178 #endif
                0179       _END_MASTER( myThid )
                0180       _BARRIER
82ff416a86 Dimi*0181 
3e6ce1cd50 Jean*0182 C---  Transfer buffer to "arrayin" array:
                0183 #ifdef EXF_INTERP_USE_DYNALLOC
2e7833c3c9 Chri*0184 #ifdef EXF_IREAD_USE_GLOBAL_POINTER
82ff416a86 Dimi*0185       IF ( filePrec .EQ. 32 ) THEN
3e6ce1cd50 Jean*0186         DO j=1,ny_in
                0187           DO i=1,nx_in
                0188             arrayin(i,j)=glPtr4(i,j)
                0189           ENDDO
                0190         ENDDO
82ff416a86 Dimi*0191       ELSE
3e6ce1cd50 Jean*0192         DO j=1,ny_in
                0193           DO i=1,nx_in
                0194             arrayin(i,j)=glPtr8(i,j)
                0195           ENDDO
                0196         ENDDO
82ff416a86 Dimi*0197       ENDIF
3e6ce1cd50 Jean*0198 #else /* ndef EXF_IREAD_USE_GLOBAL_POINTER */
82ff416a86 Dimi*0199       IF ( filePrec .EQ. 32 ) THEN
3e6ce1cd50 Jean*0200         DO j=1,ny_in
                0201           DO i=1,nx_in
                0202             arrayin(i,j)=buffer_r4(i,j)
                0203           ENDDO
                0204         ENDDO
82ff416a86 Dimi*0205       ELSE
3e6ce1cd50 Jean*0206         DO j=1,ny_in
                0207           DO i=1,nx_in
                0208             arrayin(i,j)=buffer_r8(i,j)
                0209           ENDDO
                0210         ENDDO
82ff416a86 Dimi*0211       ENDIF
3e6ce1cd50 Jean*0212 #endif /* ndef EXF_IREAD_USE_GLOBAL_POINTER */
                0213 #else  /* ndef EXF_INTERP_USE_DYNALLOC */
                0214       IF ( filePrec .EQ. 32 ) THEN
                0215         DO j=1,ny_in
                0216           ijs = (j-1)*nx_in
                0217           DO i=1,nx_in
                0218             arrayin(i,j)=buffer_r4(i+ijs)
                0219           ENDDO
                0220         ENDDO
                0221       ELSE
                0222         DO j=1,ny_in
                0223           ijs = (j-1)*nx_in
                0224           DO i=1,nx_in
                0225             arrayin(i,j)=buffer_r8(i+ijs)
                0226           ENDDO
                0227         ENDDO
                0228       ENDIF
                0229 #endif /* ndef EXF_INTERP_USE_DYNALLOC */
20bcbe789b Patr*0230 
9df47615eb Jean*0231       RETURN
20bcbe789b Patr*0232       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!