C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/pkg/mnc/mnc_readparms.F,v 1.21 2005/04/17 00:25:46 edhill Exp $ C $Name: $ #include "MNC_OPTIONS.h" C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| CBOP 0 C !ROUTINE: MNC_READPARMS C !INTERFACE: SUBROUTINE MNC_READPARMS( myThid ) C !DESCRIPTION: C Read the MNC run-time parameters file. IF the file does not C exist, MNC will assume that it is not needed (that is, some other C IO routines such as MDSIO will be used) and will not issue any C errors. C !USES: implicit none #include "SIZE.h" #include "mnc_common.h" #include "EEPARAMS.h" #include "PARAMS.h" #include "MNC_PARAMS.h" C !INPUT PARAMETERS: integer myThid CEOP C !LOCAL VARIABLES: integer i, iUnit, nl, isu1,isu2,mdu, errio, IL character*(MAX_LEN_MBUF) data_file character*(MAX_LEN_MBUF) msgBuf CHARACTER*(MAX_LEN_PREC) record NAMELIST /MNC_01/ & mnc_use_indir, mnc_use_outdir, mnc_outdir_date, & mnc_echo_gvtypes, & pickup_write_mnc, pickup_read_mnc, & timeave_mnc, snapshot_mnc, monitor_mnc, autodiff_mnc, & readgrid_mnc, & mnc_outdir_str, mnc_indir_str, mnc_max_fsize LOGICAL exst C Functions integer ILNBLNK C Set default values for MNC run-time parameters DO i = 1,MAX_LEN_FNAM mnc_outdir_str(i:i) = ' ' mnc_indir_str(i:i) = ' ' ENDDO mnc_echo_gvtypes = .FALSE. mnc_use_outdir = .FALSE. mnc_outdir_str(1:4) = 'mnc_' mnc_outdir_date = .FALSE. pickup_write_mnc = .TRUE. pickup_read_mnc = .TRUE. mnc_use_indir = .FALSE. mnc_indir_str(1:4) = ' ' monitor_mnc = .TRUE. timeave_mnc = .TRUE. snapshot_mnc = .TRUE. autodiff_mnc = .TRUE. C 2GB is 2147483648 bytes or approx: 2.1475e+09 mnc_max_fsize = 2.1 _d 9 readgrid_mnc = .FALSE. C Set the file name DO i=1,MAX_LEN_MBUF data_file(i:i) = ' ' ENDDO WRITE(data_file,'(a)') 'data.mnc' nl = ILNBLNK(data_file) C Verify that the file exists and, if not, disable MNC INQUIRE( FILE=data_file, EXIST=exst ) IF (exst) THEN WRITE(msgbuf,'(3a)') & ' MNC_READPARMS: opening file ''', & data_file(1:nl), '''' CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, & SQUEEZE_RIGHT , mythid) ELSE c WRITE(msgBuf,'(3a)') c & 'Data file: ''',data_file(1:nl), c & ''' does not exist so MNC will be disabled' c CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, c & SQUEEZE_RIGHT , mythid) c RETURN C- jmc: found strange things when data.mnc is missing: C "MNC will be disabled" is not implemented C => Safer, in this case, to stop the run here. WRITE(msgBuf,'(3a)') & 'Data file: ''',data_file(1:nl), & ''' does not exist ==> STOP' CALL PRINT_ERROR( msgBuf, mythid) STOP 'ABNORMAL END: S/R MNC_READPARMS' ENDIF C Open files isu1 = 60 isu2 = 61 mdu = 62 OPEN(UNIT=isu1, STATUS='SCRATCH') OPEN(UNIT=isu2, STATUS='SCRATCH') OPEN(UNIT=mdu, FILE=data_file, STATUS='OLD', IOSTAT=errio) IF ( errio .LT. 0 ) THEN WRITE(msgBuf,'(3a)') & 'Unable to open data file: ''',data_file(1:nl), & ''' so MNC will be disabled' CALL PRINT_ERROR( msgBuf , 1) STOP 'ABNORMAL END: S/R MNC_READPARMS' RETURN ENDIF DO WHILE ( .TRUE. ) READ(mdu,FMT='(A)',END=1001) RECORD IL = MAX(ILNBLNK(RECORD),1) IF ( RECORD(1:1) .NE. commentCharacter ) THEN CALL NML_SET_TERMINATOR( RECORD ) WRITE(UNIT=isu1,FMT='(A)') RECORD(:IL) ENDIF WRITE(UNIT=isu2,FMT='(A)') RECORD(:IL) ENDDO 1001 CONTINUE CLOSE(mdu) C-- Report contents of model parameter file WRITE(msgBuf,'(A)') & '// =======================================================' CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, & SQUEEZE_RIGHT , 1) WRITE(msgBuf,'(3a)') '// Parameter file "',data_file(1:nl),'"' CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, & SQUEEZE_RIGHT , 1) WRITE(msgBuf,'(A)') & '// =======================================================' CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, & SQUEEZE_RIGHT , 1) iUnit = isu2 REWIND(iUnit) DO WHILE ( .TRUE. ) READ(UNIT=iUnit,FMT='(A)',END=2001) RECORD IL = MAX(ILNBLNK(RECORD),1) WRITE(msgBuf,'(2a)') '>',RECORD(:IL) CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, & SQUEEZE_RIGHT , 1) ENDDO 2001 CONTINUE CLOSE(iUnit) WRITE(msgBuf,'(A)') ' ' CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, & SQUEEZE_RIGHT , 1) iUnit = isu1 REWIND(iUnit) READ(UNIT=iUnit,NML=MNC_01,IOSTAT=errio,err=3) GOTO 4 3 CONTINUE WRITE(msgBuf,'(A,A,A)') & 'ERROR: while reading file ''',data_file(1:nl), & ''' -- please check file contents' CALL PRINT_ERROR( msgBuf , 1) STOP 'ABNORMAL END: S/R MNC_READPARMS' 4 CONTINUE WRITE(msgBuf,'(a)') ' MNC_READPARMS: finished reading data.mnc' CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, & SQUEEZE_RIGHT , 1) C Pickups must always be read in an EXCLUSIVE fashion IF (pickup_read_mnc) pickup_read_mdsio = .FALSE. C IO handling is done in one of two senses: C (1) outputTypesInclusive=.TRUE. is an "inclusive-or" meaning that C one or more write methods can occur simultaneously and C (2) outputTypesInclusive=.FALSE. is an "exclusive-or" meaning that C only one write method can occur in a given run C C Since all the *_mdsio flags default to .TRUE. and C outputTypesInclusive defaults to .FALSE., the logic here is C simple: IF ( (.NOT. outputTypesInclusive) & .AND. pickup_write_mnc ) pickup_write_mdsio = .FALSE. IF ( (.NOT. outputTypesInclusive) & .AND. timeave_mnc ) timeave_mdsio = .FALSE. IF ( (.NOT. outputTypesInclusive) & .AND. snapshot_mnc ) snapshot_mdsio = .FALSE. IF ( (.NOT. outputTypesInclusive) & .AND. monitor_mnc ) monitor_stdio = .FALSE. C Reads are always an exclusive relationship IF (pickup_read_mnc) pickup_read_mdsio = .FALSE. C Create the MNC output directory IF (mnc_use_outdir) THEN CALL MNC_SET_OUTDIR(myThid) ENDIF RETURN END C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| CBOP 1 C !ROUTINE: MNC_SET_OUTDIR C !INTERFACE: SUBROUTINE MNC_SET_OUTDIR( myThid ) C !DESCRIPTION: C Create the output (sub--)directory for the MNC output files. C !USES: implicit none #include "mnc_common.h" #include "SIZE.h" #include "EEPARAMS.h" #include "PARAMS.h" #include "MNC_PARAMS.h" C !INPUT PARAMETERS: integer myThid CEOP C !LOCAL VARIABLES: integer i,j,k, ntot, npathd, idate character*(100) pathd character*(100) cenc integer ienc(100) integer ncenc C Functions integer ILNBLNK cenc(1:26) = 'abcdefghijklmnopqrstuvwxyz' cenc(27:52) = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' cenc(53:70) = '0123456789_.,+-=/~' ncenc = 70 npathd = 100 IF (mnc_outdir_date) THEN idate = 1 ELSE idate = 0 ENDIF DO i = 1,100 pathd(i:i) = ' ' ENDDO k = ILNBLNK(mnc_outdir_str) IF (k .GT. 80) k = 80 pathd(1:k) = mnc_outdir_str(1:k) ntot = 0 DO i = 1,k DO j = 1,ncenc IF (pathd(i:i) .EQ. cenc(j:j)) THEN ntot = ntot + 1 ienc(ntot) = j GOTO 20 ENDIF ENDDO 20 CONTINUE ENDDO C write(*,*) 'ntot,k = ', ntot, ',',k C DO i = 1,ntot C write(*,*) 'ienc = ', ienc(i) C ENDDO #define HAVE_MNCCDIR #ifdef HAVE_MNCCDIR CALL mnccdir(ntot, ienc, idate) #else npathd = 0 #endif DO i = 1,MNC_MAX_CHAR mnc_out_path(i:i) = ' ' ENDDO IF (ntot .GT. 0) THEN IF (ntot .GT. (MNC_MAX_CHAR-40)) THEN ntot = MNC_MAX_CHAR - 40 ENDIF DO i = 1,ntot j = ienc(i) mnc_out_path(i:i) = cenc(j:j) ENDDO mnc_out_path((ntot+1):(ntot+1)) = '/' ENDIF C k = ILNBLNK(mnc_out_path) C write(*,*) 'mnc_out_path = ''', mnc_out_path(1:k), '''' C STOP 'yoyoyo' RETURN END C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|