Back to home page

MITgcm

 
 

    


File indexing completed on 2018-03-02 18:42:58 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
24462d2fa8 Patr*0001 #include "PROFILES_OPTIONS.h"
6e4c90fea3 Patr*0002 
ae4c29e0db Jean*0003       subroutine profiles_readparms( myThid )
6e4c90fea3 Patr*0004 
                0005 c     ==================================================================
                0006 c     SUBROUTINE profiles_readparms
                0007 c     ==================================================================
                0008 c
                0009 c     o This routine initialises the package cost.
                0010 c     started: Ralf Giering 18-Jan-2001
                0011 c
                0012 c     ==================================================================
                0013 c     SUBROUTINE profiles_readparms
                0014 c     ==================================================================
                0015 
                0016       implicit none
                0017 
                0018 c     == global variables ==
                0019 
                0020 #include "EEPARAMS.h"
                0021 #include "SIZE.h"
                0022 #include "GRID.h"
                0023 #include "PARAMS.h"
                0024 
6328b73337 Gael*0025 #include "PROFILES_SIZE.h"
6e4c90fea3 Patr*0026 #include "profiles.h"
                0027 
                0028 c     == routine arguments ==
                0029 
ae4c29e0db Jean*0030       integer myThid
6e4c90fea3 Patr*0031 
                0032 c     == local variables ==
ae4c29e0db Jean*0033 C     msgBuf      - Informational/error message buffer
6e4c90fea3 Patr*0034 C     iUnit       - Work variable for IO unit number
                0035       CHARACTER*(MAX_LEN_MBUF) msgBuf
ff70818335 Gael*0036       INTEGER iUnit, num_file, num_var, IL
38287224dd Gael*0037       LOGICAL exst, specifiedNames
ff70818335 Gael*0038       character*(128) fname
                0039 
                0040 C     !FUNCTIONS
                0041       INTEGER  ILNBLNK
                0042       EXTERNAL ILNBLNK
6e4c90fea3 Patr*0043 
                0044 c     == end of interface ==
                0045 
                0046 c--   Read the namelist input.
ef53b829d7 Jean*0047       namelist /profiles_nml/
1ff0163ead Gael*0048      &                   profilesDir,
6e4c90fea3 Patr*0049      &                   profilesfiles,
b2a948f981 Gael*0050      &                   mult_profiles,
6b2230d510 Ou W*0051      &                   mult_profiles_mean,
                0052 #ifdef ALLOW_PROFILES_SAMPLESPLIT_COST
                0053 C number of independent samples
                0054      &                   profiles_mean_indsamples,
                0055 #endif
fd8f717f84 Gael*0056      &                   prof_facmod,
cf16ba6028 Gael*0057      &                   prof_names,
                0058      &                   prof_namesmod,
6b2230d510 Ou W*0059 #ifdef ALLOW_PROFILES_CLIMMASK
                0060      &                   prof_namesclim,
                0061 #endif
cf16ba6028 Gael*0062      &                   prof_itracer,
f0e4bffe35 Gael*0063      &                   profilesDoNcOutput,
                0064      &                   profilesDoGenGrid
6e4c90fea3 Patr*0065 
ae4c29e0db Jean*0066       IF ( .NOT.usePROFILES ) THEN
                0067 C-    pkg PROFILES is not used
                0068         _BEGIN_MASTER(myThid)
                0069 C-    Track pkg activation status:
                0070 C     print a (weak) warning if data.profiles is found
                0071          CALL PACKAGES_UNUSED_MSG( 'usePROFILES', ' ', ' ' )
                0072         _END_MASTER(myThid)
                0073         RETURN
                0074       ENDIF
                0075 
6e4c90fea3 Patr*0076       _BEGIN_MASTER( myThid )
                0077 
                0078 c--     Set default values.
cf16ba6028 Gael*0079       profilesDir=' '
1ff0163ead Gael*0080 
6b2230d510 Ou W*0081 
                0082 
cf16ba6028 Gael*0083       do num_file=1,NFILESPROFMAX
6e4c90fea3 Patr*0084           profilesfiles(num_file)      =    ' '
cf16ba6028 Gael*0085       enddo
                0086 
                0087       do num_file=1,NFILESPROFMAX
                0088        do num_var=1,NVARMAX
                0089         mult_profiles(num_file,num_var) = 1. _d 0
fd8f717f84 Gael*0090         prof_facmod(num_file,num_var)  = 1. _d 0
38287224dd Gael*0091         prof_names(num_file,num_var)='empty'
                0092         prof_itracer(num_file,num_var)=1
                0093         prof_namesmod(num_file,num_var)='empty'
6b2230d510 Ou W*0094 #ifdef ALLOW_PROFILES_CLIMMASK
                0095         prof_namesclim(num_file,num_var)='empty'
                0096 #endif
cf16ba6028 Gael*0097        enddo
                0098       enddo
6b2230d510 Ou W*0099       do num_var=1,NVARMAX
                0100          mult_profiles_mean(num_var) = 1. _d 0
                0101 #ifdef ALLOW_PROFILES_SAMPLESPLIT_COST
                0102          profiles_mean_indsamples(num_var) = 1
                0103 #endif
                0104       enddo
cf16ba6028 Gael*0105 
f0e4bffe35 Gael*0106       profilesDoNcOutput=.false.
0e0f68501f Gael*0107 
                0108       IF ( (.NOT.usingSphericalPolarGrid .OR. rotateGrid) ) THEN
                0109         profilesDoGenGrid=.true.
                0110       ELSE
                0111         profilesDoGenGrid=.false.
                0112       ENDIF
71a5587721 Gael*0113 
6e4c90fea3 Patr*0114 c--     Next, read the cost data file.
                0115         WRITE(msgBuf,'(A)') 'PROFILES_READPARMS: opening data.profiles'
                0116         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0117      &                    SQUEEZE_RIGHT , 1)
                0118 
                0119         CALL OPEN_COPY_DATA_FILE(
                0120      I                          'data.profiles', 'PROFILES_READPARMS',
                0121      O                          iUnit,
                0122      I                          myThid )
                0123 
                0124         READ(  iUnit, nml = profiles_nml )
                0125 
                0126         WRITE(msgBuf,'(2A)') 'PROFILES_READPARMS: ',
                0127      &       'finished reading data.profiles'
                0128         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0129      &                  SQUEEZE_RIGHT , 1)
                0130 
7a77863887 Mart*0131 #ifdef SINGLE_DISK_IO
                0132         CLOSE(iUnit)
                0133 #else
                0134         CLOSE(iUnit,STATUS='DELETE')
                0135 #endif /* SINGLE_DISK_IO */
6e4c90fea3 Patr*0136 
ff70818335 Gael*0137         do num_file=1,NFILESPROFMAX
cf16ba6028 Gael*0138 
38287224dd Gael*0139           specifiedNames=.FALSE.
                0140           do num_var=1,NVARMAX
                0141             if (prof_names(num_file,num_var).NE.'empty')
                0142      &         specifiedNames=.TRUE.
                0143           enddo
                0144 
                0145           if (.NOT.specifiedNames) then
                0146             prof_names(num_file,1)='prof_T'
                0147             prof_names(num_file,2)='prof_S'
                0148             prof_namesmod(num_file,1)='theta'
                0149             prof_namesmod(num_file,2)='salt'
6b2230d510 Ou W*0150 #ifdef ALLOW_PROFILES_CLIMMASK
                0151             prof_namesclim(num_file,1)='prof_Tclim'
                0152             prof_namesclim(num_file,2)='prof_Sclim'
                0153 #endif
38287224dd Gael*0154           endif
                0155 
                0156           do num_var=1,NVARMAX
                0157             if (((prof_names(num_file,num_var).NE.'empty').AND.
                0158      &           (prof_namesmod(num_file,num_var).EQ.'empty')).OR.
                0159      &          ((prof_names(num_file,num_var).EQ.'empty').AND.
                0160      &           (prof_namesmod(num_file,num_var).NE.'empty'))) then
                0161              print*,'prof_names=',prof_names(num_file,num_var),' ',
                0162      &         prof_namesmod(num_file,num_var),' ',num_file,num_var
                0163              WRITE(errorMessageUnit,'(2A)')
                0164      &         'ERROR in PROFILES_READPARMS: inconsistent ',
                0165      &         'prof_names and prof_namesmod'
b00d6c1700 Gael*0166              CALL ALL_PROC_DIE( myThid )
38287224dd Gael*0167              STOP 'ABNORMAL END: S/R PROFILES_READPARMS'
                0168             endif
                0169           enddo
                0170 
cf16ba6028 Gael*0171           do num_var=1,NVARMAX
                0172             IL  = ILNBLNK( prof_names(num_file,num_var) )
                0173             WRITE(prof_namesmask(num_file,num_var),'(2A)')
                0174      &        prof_names(num_file,num_var)(1:IL),'mask'
                0175             WRITE(prof_namesweight(num_file,num_var),'(2A)')
                0176      &        prof_names(num_file,num_var)(1:IL),'weight'
6b2230d510 Ou W*0177 #ifdef ALLOW_PROFILES_CLIMMASK
                0178             WRITE(prof_namesclim(num_file,num_var),'(2A)')
                0179      &        prof_names(num_file,num_var)(1:IL),'clim'
                0180 #endif
cf16ba6028 Gael*0181           enddo
                0182 
ff70818335 Gael*0183           if ( profilesfiles(num_file) .NE. ' ' ) then
                0184             IL  = ILNBLNK( profilesfiles(num_file) )
                0185             fname = profilesfiles(num_file)(1:IL)//'.nc'
                0186             inquire( file=fname, exist=exst )
                0187             if (.NOT.exst) then
                0188 c warn user as we override profilesfiles
                0189              WRITE(msgBuf,'(3A)')
7497c8dc75 Patr*0190      &       '** WARNING ** PROFILES_READPARMS: missing file: ',
ff70818335 Gael*0191      &       profilesfiles(num_file)(1:IL),' gets switched off'
                0192              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0193      &                    SQUEEZE_RIGHT , myThid)
                0194 c switch off this file (and potential cost function term)
                0195               profilesfiles(num_file) = ' '
                0196             endif
                0197           endif
                0198         enddo
                0199 
ae4c29e0db Jean*0200       _END_MASTER( myThid )
6e4c90fea3 Patr*0201 
                0202       _BARRIER
                0203 
ae4c29e0db Jean*0204       RETURN
                0205       END