C $Header: /u/gcmpack/MITgcm/pkg/profiles/profiles_readparms.F,v 1.25 2017/08/09 15:23:36 mlosch Exp $
C $Name: $
#include "PROFILES_OPTIONS.h"
subroutine PROFILES_READPARMS( myThid )
c ==================================================================
c SUBROUTINE profiles_readparms
c ==================================================================
c
c o This routine initialises the package cost.
c started: Ralf Giering 18-Jan-2001
c
c ==================================================================
c SUBROUTINE profiles_readparms
c ==================================================================
implicit none
c == global variables ==
#include "EEPARAMS.h"
#include "SIZE.h"
#include "GRID.h"
#include "PARAMS.h"
#include "PROFILES_SIZE.h"
#include "profiles.h"
c == routine arguments ==
integer myThid
c == local variables ==
C msgBuf - Informational/error message buffer
C iUnit - Work variable for IO unit number
CHARACTER*(MAX_LEN_MBUF) msgBuf
INTEGER iUnit, num_file, num_var, IL
LOGICAL exst, specifiedNames
character*(128) fname
C !FUNCTIONS
INTEGER ILNBLNK
EXTERNAL
c == end of interface ==
c-- Read the namelist input.
namelist //profiles_nml
& profilesDir,
& profilesfiles,
& mult_profiles,
& mult_profiles_mean,
#ifdef ALLOW_PROFILES_SAMPLESPLIT_COST
C number of independent samples
& profiles_mean_indsamples,
#endif
& prof_facmod,
& prof_names,
& prof_namesmod,
#ifdef ALLOW_PROFILES_CLIMMASK
& prof_namesclim,
#endif
& prof_itracer,
& profilesDoNcOutput,
& profilesDoGenGrid
IF ( .NOT.usePROFILES ) THEN
C- pkg PROFILES is not used
_BEGIN_MASTER(myThid)
C- Track pkg activation status:
C print a (weak) warning if data.profiles is found
CALL PACKAGES_UNUSED_MSG( 'usePROFILES', ' ', ' ' )
_END_MASTER(myThid)
RETURN
ENDIF
_BEGIN_MASTER( myThid )
c-- Set default values.
profilesDir=' '
do num_file=1,NFILESPROFMAX
profilesfiles(num_file) = ' '
enddo
do num_file=1,NFILESPROFMAX
do num_var=1,NVARMAX
mult_profiles(num_file,num_var) = 1. _d 0
prof_facmod(num_file,num_var) = 1. _d 0
prof_names(num_file,num_var)='empty'
prof_itracer(num_file,num_var)=1
prof_namesmod(num_file,num_var)='empty'
#ifdef ALLOW_PROFILES_CLIMMASK
prof_namesclim(num_file,num_var)='empty'
#endif
enddo
enddo
do num_var=1,NVARMAX
mult_profiles_mean(num_var) = 1. _d 0
#ifdef ALLOW_PROFILES_SAMPLESPLIT_COST
profiles_mean_indsamples(num_var) = 1
#endif
enddo
profilesDoNcOutput=.false.
IF ( (.NOT.usingSphericalPolarGrid .OR. rotateGrid) ) THEN
profilesDoGenGrid=.true.
ELSE
profilesDoGenGrid=.false.
ENDIF
c-- Next, read the cost data file.
WRITE(msgBuf,'(A)') 'PROFILES_READPARMS: opening data.profiles'
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT , 1)
CALL OPEN_COPY_DATA_FILE(
I 'data.profiles', 'PROFILES_READPARMS',
O iUnit,
I myThid )
READ( iUnit, nml = profiles_nml )
WRITE(msgBuf,'(2A)') 'PROFILES_READPARMS: ',
& 'finished reading data.profiles'
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT , 1)
#ifdef SINGLE_DISK_IO
CLOSE(iUnit)
#else
CLOSE(iUnit,STATUS='DELETE')
#endif /* SINGLE_DISK_IO */
do num_file=1,NFILESPROFMAX
specifiedNames=.FALSE.
do num_var=1,NVARMAX
if (prof_names(num_file,num_var).NE.'empty')
& specifiedNames=.TRUE.
enddo
if (.NOT.specifiedNames) then
prof_names(num_file,1)='prof_T'
prof_names(num_file,2)='prof_S'
prof_namesmod(num_file,1)='theta'
prof_namesmod(num_file,2)='salt'
#ifdef ALLOW_PROFILES_CLIMMASK
prof_namesclim(num_file,1)='prof_Tclim'
prof_namesclim(num_file,2)='prof_Sclim'
#endif
endif
do num_var=1,NVARMAX
if (((prof_names(num_file,num_var).NE.'empty').AND.
& (prof_namesmod(num_file,num_var).EQ.'empty')).OR.
& ((prof_names(num_file,num_var).EQ.'empty').AND.
& (prof_namesmod(num_file,num_var).NE.'empty'))) then
print*,'prof_names=',prof_names(num_file,num_var),' ',
& prof_namesmod(num_file,num_var),' ',num_file,num_var
WRITE(errorMessageUnit,'(2A)')
& 'ERROR in PROFILES_READPARMS: inconsistent ',
& 'prof_names and prof_namesmod'
CALL ALL_PROC_DIE( myThid )
STOP 'ABNORMAL END: S/R PROFILES_READPARMS'
endif
enddo
do num_var=1,NVARMAX
IL = ILNBLNK( prof_names(num_file,num_var) )
WRITE(prof_namesmask(num_file,num_var),'(2A)')
& prof_names(num_file,num_var)(1:IL),'mask'
WRITE(prof_namesweight(num_file,num_var),'(2A)')
& prof_names(num_file,num_var)(1:IL),'weight'
#ifdef ALLOW_PROFILES_CLIMMASK
WRITE(prof_namesclim(num_file,num_var),'(2A)')
& prof_names(num_file,num_var)(1:IL),'clim'
#endif
enddo
if ( profilesfiles(num_file) .NE. ' ' ) then
IL = ILNBLNK( profilesfiles(num_file) )
fname = profilesfiles(num_file)(1:IL)//'.nc'
inquire( file=fname, exist=exst )
if (.NOT.exst) then
c warn user as we override profilesfiles
WRITE(msgBuf,'(3A)')
& '** WARNING ** PROFILES_READPARMS: missing file: ',
& profilesfiles(num_file)(1:IL),' gets switched off'
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
& SQUEEZE_RIGHT , myThid)
c switch off this file (and potential cost function term)
profilesfiles(num_file) = ' '
endif
endif
enddo
_END_MASTER( myThid )
_BARRIER
RETURN
END