Back to home page

MITgcm
 
 

    

File indexing completed on 2026-03-19 05:08:34 UTC

view on githubraw file Latest commit 69361556 on 2026-03-18 21:20:20 UTC
b9be1e51ef Jean*0001 #include "ECCO_OPTIONS.h"
5001c65f45 Patr*0002 
22f8b844e3 Jean*0003 C--  File ecco_check.F:
                0004 C--   Contents
                0005 C--   o ECCO_CHECK
                0006 C--   o ECCO_CHECK_FILES
                0007 
                0008 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0009 
5001c65f45 Patr*0010       SUBROUTINE ECCO_CHECK( myThid )
22f8b844e3 Jean*0011 C     *==========================================================*
5001c65f45 Patr*0012 C     | SUBROUTINE ECCO_CHECK                                    |
                0013 C     | o Check runtime activated packages have been built in.   |
22f8b844e3 Jean*0014 C     *==========================================================*
5001c65f45 Patr*0015 C     | All packages can be selected/deselected at build time    |
                0016 C     | ( when code is compiled ) and activated/deactivated at   |
                0017 C     | runtime. This routine does a quick check to trap packages|
                0018 C     | that were activated at runtime but that were not compiled|
                0019 C     | in at build time.                                        |
22f8b844e3 Jean*0020 C     *==========================================================*
5001c65f45 Patr*0021       IMPLICIT NONE
                0022 
                0023 C     === Global variables ===
                0024 #include "SIZE.h"
                0025 #include "EEPARAMS.h"
69361556c2 Mart*0026 #include "ECCO_SIZE.h"
                0027 #include "ECCO.h"
7484238bfd Patr*0028 
5001c65f45 Patr*0029 C     === Routine arguments ===
                0030 C     myThid -  Number of this instances
                0031       INTEGER myThid
                0032 
f40bb882f5 Jean*0033 c     == external functions ==
025a9bb173 antn*0034       INTEGER  ILNBLNK
f40bb882f5 Jean*0035       EXTERNAL ILNBLNK
                0036 
5001c65f45 Patr*0037 C     === Local variables ===
f8e779c983 antn*0038 C     msgBuf      - Informational/error message buffer
5001c65f45 Patr*0039       CHARACTER*(MAX_LEN_MBUF) msgBuf
130273d46b Gael*0040 #ifdef ALLOW_GENCOST_CONTRIBUTION
025a9bb173 antn*0041       INTEGER igen_etagcm, il
                0042       INTEGER igen_tp, igen_ers, igen_gfo, use_mon_int, use_day_int
cbd85e4123 Gael*0043       LOGICAL exst
9f5240b52a Jean*0044       CHARACTER*(128) tempfile
a5ed45e6de An T*0045       INTEGER icount_transp
35c4fdc74b Emma*0046       INTEGER k
130273d46b Gael*0047 #endif
f40bb882f5 Jean*0048       INTEGER nRetired
cbd85e4123 Gael*0049 
7484238bfd Patr*0050       _BEGIN_MASTER(myThid)
                0051 
d4b64b229a Jean*0052       WRITE(msgBuf,'(2A)') 'ECCO_CHECK: ',
                0053      &                     ' --> Starts to check ECCO set-up'
                0054       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0055      &                    SQUEEZE_RIGHT, myThid )
                0056 
b8fab26f74 Gael*0057 c ============ retired compile option checks
cda1c18f72 Jean*0058       nRetired = 0
8836fabb97 Gael*0059 
                0060 #ifdef ALLOW_MEAN_HFLUX_COST_CONTRIBUTION
                0061            WRITE(msgBuf,'(3A)') '** WARNING ** ECCO_CHECK:',
                0062      &      'ALLOW_MEAN_HFLUX_COST_CONTRIBUTION has no',
                0063      &      'effect since cost_mean_heatflux has been retired'
                0064            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0065      &                     SQUEEZE_RIGHT , myThid )
                0066        nRetired = nRetired + 1
                0067 #endif
                0068 #ifdef ALLOW_MEAN_SFLUX_COST_CONTRIBUTION
                0069            WRITE(msgBuf,'(3A)') '** WARNING ** ECCO_CHECK:',
2b959ba38e Mart*0070      &      'ALLOW_MEAN_SFLUX_COST_CONTRIBUTION has no',
8836fabb97 Gael*0071      &      'effect since cost_mean_saltflux has been retired'
                0072            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0073      &                     SQUEEZE_RIGHT , myThid )
                0074        nRetired = nRetired + 1
                0075 #endif
2b959ba38e Mart*0076 #ifdef ALLOW_SSH_GLOBMEAN_COST_CONTRIBUTION
                0077            WRITE(msgBuf,'(3A)') '** WARNING ** ECCO_CHECK:',
                0078      &      'ALLOW_SSH_GLOBMEAN_COST_CONTRIBUTION has no',
                0079      &      'effect since cost_ssh_globmean has been retired'
                0080            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0081      &                     SQUEEZE_RIGHT , myThid )
                0082        nRetired = nRetired + 1
                0083 #endif
8836fabb97 Gael*0084 #ifdef ALLOW_NEW_SSH_COST
                0085            WRITE(msgBuf,'(3A)') '** WARNING ** ECCO_CHECK:',
                0086      &      'ALLOW_NEW_SSH_COST has no',
                0087      &      'effect since cost_ssh_new has been retired'
                0088            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0089      &                     SQUEEZE_RIGHT , myThid )
                0090        nRetired = nRetired + 1
                0091 #endif
                0092 #ifdef ALLOW_CURMTR_COST_CONTRIBUTION
                0093            WRITE(msgBuf,'(3A)') '** WARNING ** ECCO_CHECK:',
                0094      &      'ALLOW_CURMTR_COST_CONTRIBUTION has no',
                0095      &      'effect since cost_curmtr has been retired'
                0096            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0097      &                     SQUEEZE_RIGHT , myThid )
                0098        nRetired = nRetired + 1
                0099 #endif
                0100 #ifdef ALLOW_DRIFTER_COST_CONTRIBUTION
                0101            WRITE(msgBuf,'(3A)') '** WARNING ** ECCO_CHECK:',
                0102      &      'ALLOW_DRIFTER_COST_CONTRIBUTION has no',
                0103      &      'effect since cost_drifter has been retired'
                0104            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0105      &                     SQUEEZE_RIGHT , myThid )
                0106        nRetired = nRetired + 1
                0107 #endif
cda1c18f72 Jean*0108 #ifdef ALLOW_BP_COST_CONTRIBUTION
                0109         WRITE(msgBuf,'(3A)') 'ECCO_CHECK:',
                0110      &      ' "ALLOW_BP_COST_CONTRIBUTION" has been removed',
                0111      &      ' since cost_bp has been retired'
                0112         CALL PRINT_ERROR( msgBuf, myThid )
                0113         nRetired = nRetired + 1
                0114 #endif
8836fabb97 Gael*0115 #ifdef ALLOW_SCAT_COST_CONTRIBUTION
                0116            WRITE(msgBuf,'(3A)') '** WARNING ** ECCO_CHECK:',
                0117      &      'ALLOW_SCAT_COST_CONTRIBUTION has no',
                0118      &      'effect since cost_scat etc has been retired'
                0119            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0120      &                     SQUEEZE_RIGHT , myThid )
                0121        nRetired = nRetired + 1
                0122 #endif
                0123 #ifdef ALLOW_DAILYSCAT_COST_CONTRIBUTION
                0124            WRITE(msgBuf,'(3A)') '** WARNING ** ECCO_CHECK:',
                0125      &      'ALLOW_DAILYSCAT_COST_CONTRIBUTION has no',
                0126      &      'effect since cost_scat etc has been retired'
                0127            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0128      &                     SQUEEZE_RIGHT , myThid )
                0129        nRetired = nRetired + 1
                0130 #endif
                0131 #ifdef ALLOW_DRIFT_COST_CONTRIBUTION
                0132            WRITE(msgBuf,'(3A)') '** WARNING ** ECCO_CHECK:',
                0133      &      'ALLOW_DRIFT_COST_CONTRIBUTION has no',
                0134      &      'effect since cost_drift has been retired'
                0135            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0136      &                     SQUEEZE_RIGHT , myThid )
                0137        nRetired = nRetired + 1
                0138 #endif
                0139 #ifdef ALLOW_DRIFTW_COST_CONTRIBUTION
                0140            WRITE(msgBuf,'(3A)') '** WARNING ** ECCO_CHECK:',
                0141      &      'ALLOW_DRIFTW_COST_CONTRIBUTION has no',
                0142      &      'effect since cost_driftw has been retired'
                0143            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0144      &                     SQUEEZE_RIGHT , myThid )
                0145        nRetired = nRetired + 1
                0146 #endif
                0147 #ifdef ALLOW_COST_INI_FIN
                0148            WRITE(msgBuf,'(3A)') '** WARNING ** ECCO_CHECK:',
                0149      &      'ALLOW_COST_INI_FIN has no',
                0150      &      'effect since cost_theta_ini_fin etc has been retired'
                0151            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0152      &                     SQUEEZE_RIGHT , myThid )
                0153        nRetired = nRetired + 1
                0154 #endif
                0155 #ifdef ALLOW_COST_TRANSPORT
                0156            WRITE(msgBuf,'(3A)') '** WARNING ** ECCO_CHECK:',
                0157      &      'ALLOW_COST_TRANSPORT has no',
                0158      &      'effect since cost_trans_merid etc has been retired'
                0159            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0160      &                     SQUEEZE_RIGHT , myThid )
                0161        nRetired = nRetired + 1
                0162 #endif
                0163 #ifdef ALLOW_COST_ATLANTIC
                0164            WRITE(msgBuf,'(3A)') '** WARNING ** ECCO_CHECK:',
                0165      &      'ALLOW_COST_ATLANTIC has no',
                0166      &      'effect since cost_atlantic has been retired'
                0167            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0168      &                     SQUEEZE_RIGHT , myThid )
                0169        nRetired = nRetired + 1
                0170 #endif
                0171 #ifdef ALLOW_TRANSPORT_COST_CONTRIBUTION
                0172            WRITE(msgBuf,'(3A)') '** WARNING ** ECCO_CHECK:',
                0173      &      'ALLOW_TRANSPORT_COST_CONTRIBUTION has no',
                0174      &      'effect since cost_gen_transport has been retired'
                0175            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0176      &                     SQUEEZE_RIGHT , myThid )
                0177        nRetired = nRetired + 1
                0178 #endif
                0179 #ifdef ALLOW_EGM96_ERROR_COV
                0180            WRITE(msgBuf,'(3A)') '** WARNING ** ECCO_CHECK:',
                0181      &      'ALLOW_EGM96_ERROR_COV has no',
                0182      &      'effect since cost_geoid etc has been retired'
                0183            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0184      &                     SQUEEZE_RIGHT , myThid )
                0185        nRetired = nRetired + 1
                0186 #endif
                0187 #ifdef ALLOW_IESTAU_COST_CONTRIBUTION
                0188            WRITE(msgBuf,'(3A)') '** WARNING ** ECCO_CHECK:',
                0189      &      'ALLOW_IESTAU_COST_CONTRIBUTION has no',
                0190      &      'effect since cost_ies etc has been retired'
                0191            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0192      &                     SQUEEZE_RIGHT , myThid )
                0193        nRetired = nRetired + 1
                0194 #endif
                0195 #ifdef ALLOW_SIGMAR_COST_CONTRIBUTION
                0196            WRITE(msgBuf,'(3A)') '** WARNING ** ECCO_CHECK:',
                0197      &      'ALLOW_SIGMAR_COST_CONTRIBUTION has no',
                0198      &      'effect since cost_sigmar has been retired'
                0199            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0200      &                     SQUEEZE_RIGHT , myThid )
                0201        nRetired = nRetired + 1
                0202 #endif
                0203 #ifdef ALLOW_EDDYPSI_COST_CONTRIBUTION
                0204            WRITE(msgBuf,'(3A)') '** WARNING ** ECCO_CHECK:',
                0205      &      'ALLOW_EDDYPSI_COST_CONTRIBUTION has no',
                0206      &      'effect since cost_tau_eddy has been retired'
                0207            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0208      &                     SQUEEZE_RIGHT , myThid )
                0209        nRetired = nRetired + 1
                0210 #endif
69361556c2 Mart*0211 #ifdef ALLOW_OBCS_COST_CONTRIBUTION
                0212        WRITE(msgBuf,'(2A)') '** WARNING ** ECCO_CHECK:',
                0213      &      'ALLOW_OBCS_COST_CONTRIBUTION has been retired'
                0214        CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0215      &                     SQUEEZE_RIGHT , myThid )
                0216        nRetired = nRetired + 1
                0217 #endif
                0218 #ifdef ALLOW_OBCSN_COST_CONTRIBUTION
                0219        WRITE(msgBuf,'(2A)') '** WARNING ** ECCO_CHECK:',
                0220      &      'ALLOW_OBCSN_COST_CONTRIBUTION has been retired'
                0221        CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0222      &                     SQUEEZE_RIGHT , myThid )
                0223        nRetired = nRetired + 1
                0224 #endif
                0225 #ifdef ALLOW_OBCSS_COST_CONTRIBUTION
                0226        WRITE(msgBuf,'(2A)') '** WARNING ** ECCO_CHECK:',
                0227      &      'ALLOW_OBCSS_COST_CONTRIBUTION has been retired'
                0228        CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0229      &                     SQUEEZE_RIGHT , myThid )
                0230        nRetired = nRetired + 1
                0231 #endif
                0232 #ifdef ALLOW_OBCSW_COST_CONTRIBUTION
                0233        WRITE(msgBuf,'(2A)') '** WARNING ** ECCO_CHECK:',
                0234      &      'ALLOW_OBCSW_COST_CONTRIBUTION has been retired'
                0235        CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0236      &                     SQUEEZE_RIGHT , myThid )
                0237        nRetired = nRetired + 1
                0238 #endif
                0239 #ifdef ALLOW_OBCSE_COST_CONTRIBUTION
                0240        WRITE(msgBuf,'(2A)') '** WARNING ** ECCO_CHECK:',
                0241      &      'ALLOW_OBCSE_COST_CONTRIBUTION has been retired'
                0242        CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0243      &                     SQUEEZE_RIGHT , myThid )
                0244        nRetired = nRetired + 1
                0245 #endif
8836fabb97 Gael*0246 
                0247       IF ( nRetired .GT. 0 ) THEN
                0248        WRITE(msgBuf,'(2A)') 'S/R ECCO_CHECK: ',
cda1c18f72 Jean*0249      &  '  retired compile-time options need to be removed'
8836fabb97 Gael*0250        CALL PRINT_ERROR( msgBuf, myThid )
cda1c18f72 Jean*0251        CALL ALL_PROC_DIE( 0 )
8836fabb97 Gael*0252        STOP 'ABNORMAL END: S/R ECCO_CHECK'
                0253       ENDIF
                0254 
b8fab26f74 Gael*0255 c ============ retired run-time parameter checks
cda1c18f72 Jean*0256       nRetired = 0
b8fab26f74 Gael*0257 
                0258 #ifdef ALLOW_GENCOST_CONTRIBUTION
f40bb882f5 Jean*0259       DO k=1,NGENCOST
b8fab26f74 Gael*0260        IF (gencost_scalefile(k).NE.' ') THEN
                0261            WRITE(msgBuf,'(3A)') '** WARNING ** ECCO_CHECK:',
                0262      &      'gencost_scalefile has been retired; ',
                0263      &      'gencost_posproc_c should now be used instead'
                0264            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
7484238bfd Patr*0265      &                     SQUEEZE_RIGHT , myThid )
b8fab26f74 Gael*0266            nRetired = nRetired + 1
                0267        ENDIF
                0268        IF (gencost_smooth2Ddiffnbt(k).NE.0) THEN
                0269            WRITE(msgBuf,'(3A)') '** WARNING ** ECCO_CHECK:',
                0270      &      'gencost_smooth2Ddiffnbt has been retired; ',
                0271      &      'gencost_posproc_i should now be used instead'
                0272            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0273      &                     SQUEEZE_RIGHT , myThid )
                0274            nRetired = nRetired + 1
                0275        ENDIF
                0276        IF (gencost_timevaryweight(k)) THEN
                0277            WRITE(msgBuf,'(3A)') '** WARNING ** ECCO_CHECK:',
                0278      &      'gencost_timevaryweight has been retired; ',
                0279      &      'gencost_posproc should now be used instead'
                0280            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0281      &                     SQUEEZE_RIGHT , myThid )
                0282            nRetired = nRetired + 1
                0283        ENDIF
                0284        IF (gencost_nrecperiod(k).NE.0) THEN
                0285            WRITE(msgBuf,'(3A)') '** WARNING ** ECCO_CHECK:',
                0286      &      'gencost_nrecperiod has been retired; ',
                0287      &      'gencost_posproc clim should now be used instead'
                0288            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0289      &                     SQUEEZE_RIGHT , myThid )
                0290            nRetired = nRetired + 1
                0291        ENDIF
                0292 
                0293       ENDDO
                0294 #endif
                0295 
                0296       IF ( nRetired .GT. 0 ) THEN
                0297        WRITE(msgBuf,'(2A)') 'S/R ECCO_CHECK: ',
                0298      &  '  retired run-time options were found in data.ecco'
                0299        CALL PRINT_ERROR( msgBuf, myThid )
cda1c18f72 Jean*0300        CALL ALL_PROC_DIE( 0 )
7484238bfd Patr*0301        STOP 'ABNORMAL END: S/R ECCO_CHECK'
                0302       ENDIF
                0303 
b8fab26f74 Gael*0304 c ============ backward compatibility checks
49484c0542 Gael*0305       IF ( (using_topex).AND.(.NOT.using_tpj) ) using_tpj=.TRUE.
                0306 
7484238bfd Patr*0307       _END_MASTER(myThid)
5001c65f45 Patr*0308 
b8fab26f74 Gael*0309 c ============ generic cost function related checks
                0310 
130273d46b Gael*0311 #ifdef ALLOW_GENCOST_CONTRIBUTION
a5ed45e6de An T*0312       icount_transp=0
025a9bb173 antn*0313       igen_tp = 0
                0314       igen_ers = 0
                0315       igen_gfo = 0
f40bb882f5 Jean*0316       DO k=1,NGENCOST
17944dd1e8 Gael*0317 
f40bb882f5 Jean*0318          IF (gencost_pointer3d(k).GT.NGENCOST3D) THEN
5cce2b5d76 Gael*0319            WRITE(msgBuf,'(2A)')
                0320      &      'ECCO_CHECK: too many 3D cost terms; please',
                0321      &      'increase NGENCOST3D and recompile.'
                0322            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0323      &                     SQUEEZE_RIGHT , myThid )
                0324            CALL PRINT_ERROR( msgBuf , myThid )
                0325            STOP 'ABNORMAL END: S/R ECCO_CHECK'
f40bb882f5 Jean*0326          ENDIF
5cce2b5d76 Gael*0327 
f40bb882f5 Jean*0328          IF (gencost_msk_pointer3d(k).GT.NGENCOST3D) THEN
17944dd1e8 Gael*0329            WRITE(msgBuf,'(2A)')
                0330      &      'ECCO_CHECK: too many 3D msk terms; please',
                0331      &      'increase NGENCOST3D and recompile.'
                0332            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0333      &                     SQUEEZE_RIGHT , myThid )
                0334            CALL PRINT_ERROR( msgBuf , myThid )
                0335            STOP 'ABNORMAL END: S/R ECCO_CHECK'
f40bb882f5 Jean*0336          ENDIF
17944dd1e8 Gael*0337 
f40bb882f5 Jean*0338          IF ( gencost_datafile(k) .NE. ' ' ) THEN
9f3ef6a237 Gael*0339 
130273d46b Gael*0340            CALL ECCO_CHECK_FILES( using_gencost(k), 'gencost',
49484c0542 Gael*0341      &       gencost_datafile(k), gencost_startdate1(k), myThid )
9f3ef6a237 Gael*0342 
cbd85e4123 Gael*0343 c--
f40bb882f5 Jean*0344            IF ( (gencost_preproc(1,k).EQ.'variaweight').AND.
                0345      &          ( gencost_errfile(k) .NE. ' ' ) ) THEN
cbd85e4123 Gael*0346              CALL ECCO_CHECK_FILES( using_gencost(k), 'gencost',
                0347      &         gencost_errfile(k), gencost_startdate1(k), myThid )
f40bb882f5 Jean*0348            ELSEIF ( gencost_errfile(k) .NE. ' ' ) THEN
                0349              il = ILNBLNK(gencost_errfile(k))
cbd85e4123 Gael*0350              inquire( file=gencost_errfile(k)(1:il), exist=exst )
f40bb882f5 Jean*0351              IF (.NOT.exst) THEN
cbd85e4123 Gael*0352                using_gencost(k)=.FALSE.
f40bb882f5 Jean*0353                il = ILNBLNK(gencost_name(k))
cbd85e4123 Gael*0354                WRITE(msgBuf,'(4A)')
69361556c2 Mart*0355      &           '** WARNING ** ECCO_CHECK: missing error file',
cbd85e4123 Gael*0356      &           ' so ',gencost_name(k)(1:il),' gets switched off'
                0357                CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0358      &                    SQUEEZE_RIGHT , myThid)
f40bb882f5 Jean*0359              ENDIF
                0360            ENDIF
cbd85e4123 Gael*0361 
9f3ef6a237 Gael*0362 c altimetry related checks
b8fab26f74 Gael*0363 
025a9bb173 antn*0364          IF (gencost_name(k).EQ.'sshv4-tp') THEN
                0365            igen_tp = k
                0366            using_tpj = using_gencost(k)
                0367          ENDIF
                0368          IF (gencost_name(k).EQ.'sshv4-ers') THEN
                0369            igen_ers = k
                0370            using_ers = using_gencost(k)
                0371          ENDIF
                0372          IF (gencost_name(k).EQ.'sshv4-gfo') THEN
                0373            igen_gfo = k
                0374            using_gfo = using_gencost(k)
                0375          ENDIF
f40bb882f5 Jean*0376          IF (gencost_name(k).EQ.'sshv4-mdt') using_mdt=using_gencost(k)
9f3ef6a237 Gael*0377 
                0378 c seaice related checks
f40bb882f5 Jean*0379          IF (gencost_name(k).EQ.'siv4-conc')
3f6d0eeb99 Gael*0380      &       using_cost_seaice=using_gencost(k)
f40bb882f5 Jean*0381          IF (gencost_name(k).EQ.'siv4-deconc')
3f6d0eeb99 Gael*0382      &       using_cost_seaice=using_gencost(k)
f40bb882f5 Jean*0383          IF (gencost_name(k).EQ.'siv4-exconc')
3f6d0eeb99 Gael*0384      &       using_cost_seaice=using_gencost(k)
f40bb882f5 Jean*0385 catn-- put STOP statement if use old siv4 names:
                0386          IF (gencost_name(k).EQ.'siv4-sst') THEN
0a8c2c2ff2 An T*0387            WRITE(msgBuf,'(2A)')
                0388      &      'ECCO_CHECK: OLD seaice gencost_name siv4-sst is retired,',
                0389      &      ' NEW name is siv4-deconc'
                0390            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0391      &                     SQUEEZE_RIGHT , myThid )
                0392            CALL PRINT_ERROR( msgBuf , myThid )
                0393            STOP 'ABNORMAL END: S/R ECCO_CHECK'
f40bb882f5 Jean*0394          ENDIF
                0395          IF (gencost_name(k).EQ.'siv4-vol') THEN
0a8c2c2ff2 An T*0396            WRITE(msgBuf,'(2A)')
                0397      &      'ECCO_CHECK: OLD seaice gencost_name siv4-vol is retired,',
                0398      &      ' NEW name is siv4-exconc'
                0399            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0400      &                     SQUEEZE_RIGHT , myThid )
                0401            CALL PRINT_ERROR( msgBuf , myThid )
                0402            STOP 'ABNORMAL END: S/R ECCO_CHECK'
f40bb882f5 Jean*0403          ENDIF
9f3ef6a237 Gael*0404 
f8e779c983 antn*0405 c-atn add another block for cost that do not need datafile but
877e0f385b An T*0406 c should have checks for other things:
                0407 c here, separate into different gencost_flag block
f40bb882f5 Jean*0408          ELSE  !if ( gencost_datafile(k) .NE. ' ' ) THEN
877e0f385b An T*0409 c---------------- block -1 ----------------------------
                0410 c block -1: cost ssh-[mdt,lsc,amsre-lsc] do not need datafile
                0411 c but need errfile. at the moment do not accomodate variaweight.
f40bb882f5 Jean*0412           IF (gencost_flag(k).EQ. -1) THEN
                0413             IF (gencost_errfile(k) .NE. ' ') THEN
                0414              il = ILNBLNK(gencost_errfile(k))
877e0f385b An T*0415              inquire( file=gencost_errfile(k)(1:il), exist=exst )
f40bb882f5 Jean*0416              IF (.NOT.exst) THEN
877e0f385b An T*0417               using_gencost(k)=.FALSE.
f40bb882f5 Jean*0418               il = ILNBLNK(gencost_name(k))
877e0f385b An T*0419               WRITE(msgBuf,'(4A)')
69361556c2 Mart*0420      &          '** WARNING ** ECCO_CHECK: missing error file',
877e0f385b An T*0421      &          ' so ',gencost_name(k)(1:il),' gets switched off'
                0422               CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0423      &                   SQUEEZE_RIGHT , myThid)
f40bb882f5 Jean*0424              ENDIF
                0425             ELSEIF(.NOT.(gencost_name(k).EQ.'sshv4-gmsl')) THEN
877e0f385b An T*0426              using_gencost(k)=.FALSE.
f40bb882f5 Jean*0427              il = ILNBLNK(gencost_name(k))
877e0f385b An T*0428              WRITE(msgBuf,'(4A)')
69361556c2 Mart*0429      &        '** WARNING ** ECCO_CHECK: error file not defined',
877e0f385b An T*0430      &        ' so ',gencost_name(k)(1:il),' gets switched off'
                0431              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0432      &                  SQUEEZE_RIGHT , myThid)
f40bb882f5 Jean*0433             ENDIF
877e0f385b An T*0434 
                0435 c---------------- block -3 ----------------------------
                0436 c-- boxmean: require [err,bar]file, can have datafile, not checked here
                0437 c-- also not checked for variwei at the moment
f40bb882f5 Jean*0438           ELSEIF(gencost_flag(k) .EQ. -3 ) THEN
877e0f385b An T*0439            WRITE(msgBuf,'(A,i3,L5)')
447bdc4b79 Gael*0440      &     'entering boxmean/horflux check,k,using_gencost(k): ,',
877e0f385b An T*0441      &     k,using_gencost(k)
                0442            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0443      &                        SQUEEZE_RIGHT , myThid)
                0444 
f40bb882f5 Jean*0445             IF (gencost_errfile(k) .NE. ' ') THEN
47d80787ea Gael*0446               WRITE(msgBuf,'(3A)') 'S/R ECCO_CHECK: boxmean now ',
                0447      &          ' uses gencost_mask instead of gencost_errfile --',
                0448      &          ' please update data.ecco accordingly'
                0449               CALL PRINT_ERROR( msgBuf, myThid )
                0450               STOP 'ABNORMAL END: S/R ECCO_CHECK'
f40bb882f5 Jean*0451             ENDIF
47d80787ea Gael*0452 
f40bb882f5 Jean*0453             IF (gencost_mask(k) .EQ. ' ') THEN
47d80787ea Gael*0454               using_gencost(k)=.FALSE.
f40bb882f5 Jean*0455               il = ILNBLNK(gencost_name(k))
47d80787ea Gael*0456               WRITE(msgBuf,'(4A)')
69361556c2 Mart*0457      &          '** WARNING ** ECCO_CHECK: gencost_mask is',
47d80787ea Gael*0458      &          ' undefined so ',gencost_name(k)(1:il),
                0459      &          ' gets switched off'
                0460               CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0461      &                   SQUEEZE_RIGHT , myThid)
f40bb882f5 Jean*0462             ENDIF
47d80787ea Gael*0463 
f40bb882f5 Jean*0464             IF ((gencost_mask(k) .NE. ' ').AND.
                0465      &          (gencost_barfile(k)(1:9).EQ.'m_boxmean')) THEN
                0466              il = ILNBLNK(gencost_mask(k))
                0467              WRITE(tempfile(1:128),'(2A)') gencost_mask(k)(1:il),'C'
47d80787ea Gael*0468              inquire( file=tempfile(1:il+1), exist=exst )
f40bb882f5 Jean*0469              IF (.NOT.exst) THEN
47d80787ea Gael*0470                using_gencost(k)=.FALSE.
f40bb882f5 Jean*0471                il = ILNBLNK(gencost_name(k))
47d80787ea Gael*0472                WRITE(msgBuf,'(4A)')
69361556c2 Mart*0473      &           '** WARNING ** ECCO_CHECK: missing mask C file',
47d80787ea Gael*0474      &           ' so ',gencost_name(k)(1:il),' gets switched off'
                0475                CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0476      &                    SQUEEZE_RIGHT , myThid)
f40bb882f5 Jean*0477              ENDIF
                0478             ENDIF
47d80787ea Gael*0479 
f40bb882f5 Jean*0480             IF ((gencost_mask(k) .NE. ' ').AND.
                0481      &          (gencost_barfile(k)(1:9).EQ.'m_horflux')) THEN
                0482              il = ILNBLNK(gencost_mask(k))
                0483              WRITE(tempfile(1:128),'(2A)') gencost_mask(k)(1:il),'W'
47d80787ea Gael*0484              inquire( file=tempfile(1:il+1), exist=exst )
f40bb882f5 Jean*0485              IF (.NOT.exst) THEN
47d80787ea Gael*0486                using_gencost(k)=.FALSE.
f40bb882f5 Jean*0487                il = ILNBLNK(gencost_name(k))
47d80787ea Gael*0488                WRITE(msgBuf,'(4A)')
69361556c2 Mart*0489      &           '** WARNING ** ECCO_CHECK: missing mask W file',
47d80787ea Gael*0490      &           ' so ',gencost_name(k)(1:il),' gets switched off'
                0491                CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0492      &                    SQUEEZE_RIGHT , myThid)
f40bb882f5 Jean*0493              ENDIF
47d80787ea Gael*0494 c
f40bb882f5 Jean*0495              il = ILNBLNK(gencost_mask(k))
                0496              WRITE(tempfile(1:128),'(2A)') gencost_mask(k)(1:il),'S'
47d80787ea Gael*0497              inquire( file=tempfile(1:il+1), exist=exst )
f40bb882f5 Jean*0498              IF (.NOT.exst) THEN
47d80787ea Gael*0499                using_gencost(k)=.FALSE.
f40bb882f5 Jean*0500                il = ILNBLNK(gencost_name(k))
47d80787ea Gael*0501                WRITE(msgBuf,'(4A)')
69361556c2 Mart*0502      &           '** WARNING ** ECCO_CHECK: missing mask S file',
47d80787ea Gael*0503      &           ' so ',gencost_name(k)(1:il),' gets switched off'
                0504                CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0505      &                    SQUEEZE_RIGHT , myThid)
f40bb882f5 Jean*0506              ENDIF
                0507             ENDIF
47d80787ea Gael*0508 
877e0f385b An T*0509 c-- check barfile, make sure character m_[theta,salt] match exactly
                0510 c-- (upper/lower-case matters) in cost_gencost_customize
f40bb882f5 Jean*0511            IF (.NOT.(
bdae1843b8 Gael*0512      &          (gencost_barfile(k)(1:15).EQ.'m_boxmean_theta').OR.
                0513      &          (gencost_barfile(k)(1:13).EQ.'m_boxmean_eta').OR.
447bdc4b79 Gael*0514      &          (gencost_barfile(k)(1:14).EQ.'m_boxmean_salt').OR.
248a3ebb42 Gael*0515      &          (gencost_barfile(k)(1:17).EQ.'m_boxmean_ptracer').OR.
38d78826c7 Ciar*0516      &          (gencost_barfile(k)(1:13).EQ.'m_boxmean_vol').OR.
7b8b86ab99 Timo*0517      &          (gencost_barfile(k)(1:16).EQ.'m_boxmean_shifwf').OR.
                0518      &          (gencost_barfile(k)(1:16).EQ.'m_boxmean_shihtf').OR.
c525843658 Emma*0519      &          (gencost_barfile(k)(1:13).EQ.'m_horflux_vol')
f40bb882f5 Jean*0520      &        )) THEN
877e0f385b An T*0521             using_gencost(k)=.FALSE.
f40bb882f5 Jean*0522             il=ILNBLNK(gencost_barfile(k))
877e0f385b An T*0523             WRITE(msgBuf,'(3A)')
                0524      &      '** WARNING ** S/R ECCO_CHECK: barfile ',
                0525      &      gencost_barfile(k)(1:il),': has no matched model var.'
                0526             CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0527      &                          SQUEEZE_RIGHT, myThid )
                0528             WRITE(msgBuf,'(A)') 'Edit cost_gencost_customize to fix. '
                0529             CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0530      &                          SQUEEZE_RIGHT, myThid )
f40bb882f5 Jean*0531             il = ILNBLNK(gencost_name(k))
877e0f385b An T*0532           WRITE(msgBuf,'(2A)') gencost_name(k)(1:il),' is switched off'
                0533             CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0534      &                          SQUEEZE_RIGHT, myThid )
f40bb882f5 Jean*0535            ENDIF !barfile
877e0f385b An T*0536 
                0537 c---------------- block -4 ----------------------------
736e27304c Timo*0538 c-- transs: require [mask,bar][W,S]file, can have datafile, but
877e0f385b An T*0539 c-- not checked here. also not checked for variwei at the moment
f40bb882f5 Jean*0540          ELSEIF ( (gencost_flag(k).EQ. -4) .OR.
                0541      &            (gencost_flag(k).EQ. -5) ) THEN
877e0f385b An T*0542           WRITE(msgBuf,'(A,i3,L5)')
df462307fb Timo*0543      &     'ecco_check for gencost transp & moc; k,using_gencost(k): ,',
877e0f385b An T*0544      &     k,using_gencost(k)
                0545           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0546      &                        SQUEEZE_RIGHT , myThid)
                0547 
736e27304c Timo*0548 C ---
                0549 C Warn the user that this is a less tested objective function
0d7023b5ce Jean*0550 C TBD: Write a more consistent transport objective function
736e27304c Timo*0551 C ---
                0552 
f40bb882f5 Jean*0553           IF ((gencost_barfile(k)(1:7).EQ.'m_trVol').AND.
                0554      &        (gencost_flag(k).EQ.-4)) THEN
0d7023b5ce Jean*0555            WRITE(msgBuf,'(A)')
df462307fb Timo*0556      &  '** WARNING ** ECCO_CHECK: cost_gencost_transp.F not tested'
736e27304c Timo*0557            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0558      &                         SQUEEZE_RIGHT, myThid )
0d7023b5ce Jean*0559            WRITE(msgBuf,'(A)')
736e27304c Timo*0560      &   ' See m_horflux_vol via cost_gencost_boxmean.F.'
                0561            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0562      &                         SQUEEZE_RIGHT, myThid )
f40bb882f5 Jean*0563           ELSEIF( (gencost_barfile(k)(1:8).EQ.'m_trHeat').OR.
                0564      &            (gencost_barfile(k)(1:8).EQ.'m_trSalt') ) THEN
0d7023b5ce Jean*0565            WRITE(msgBuf,'(2A)')
736e27304c Timo*0566      &   '** WARNING ** ECCO_CHECK: m_tr[Heat,Salt] to be used with',
                0567      &   ' caution because:'
                0568            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0569      &                         SQUEEZE_RIGHT, myThid )
0d7023b5ce Jean*0570            WRITE(msgBuf,'(A)')
736e27304c Timo*0571      &  '  (1) advection inconsistent unless ENUM_CENTERED_2ND is used'
                0572            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0573      &                         SQUEEZE_RIGHT, myThid )
0d7023b5ce Jean*0574            WRITE(msgBuf,'(A)')
736e27304c Timo*0575      &  '  (2) bolus velocities not included'
                0576            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0577      &                         SQUEEZE_RIGHT, myThid )
0d7023b5ce Jean*0578            WRITE(msgBuf,'(A)')
736e27304c Timo*0579      &  '  (3) diffusion components not included'
                0580            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0581      &                         SQUEEZE_RIGHT, myThid )
f40bb882f5 Jean*0582          ENDIF
736e27304c Timo*0583 
                0584 C ---
                0585 C Note to user: use gencost_mask not errfile
                0586 C ---
f40bb882f5 Jean*0587           IF (gencost_errfile(k) .NE. ' ') THEN
df462307fb Timo*0588             WRITE(msgBuf,'(3A)') 'S/R ECCO_CHECK: transp & moc now ',
                0589      &        ' use gencost_mask instead of gencost_errfile --',
736e27304c Timo*0590      &        ' please update data.ecco accordingly'
                0591             CALL PRINT_ERROR( msgBuf, myThid )
                0592             STOP 'ABNORMAL END: S/R ECCO_CHECK'
f40bb882f5 Jean*0593           ENDIF
736e27304c Timo*0594 
f40bb882f5 Jean*0595           IF (gencost_mask(k) .EQ. ' ') THEN
736e27304c Timo*0596             using_gencost(k)=.FALSE.
f40bb882f5 Jean*0597             il = ILNBLNK(gencost_name(k))
736e27304c Timo*0598             WRITE(msgBuf,'(4A)')
69361556c2 Mart*0599      &        '** WARNING ** ECCO_CHECK: gencost_mask is',
736e27304c Timo*0600      &        ' undefined so ',gencost_name(k)(1:il),
                0601      &        ' gets switched off'
                0602             CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0603      &                 SQUEEZE_RIGHT , myThid)
                0604 
f40bb882f5 Jean*0605           ELSE
a5ed45e6de An T*0606 c-- West ----------------------
f40bb882f5 Jean*0607            il = ILNBLNK(gencost_mask(k))
                0608            WRITE(tempfile(1:128),'(2A)') gencost_mask(k)(1:il),'W'
039a16fdf5 Gael*0609            inquire( file=tempfile(1:il+1), exist=exst )
f40bb882f5 Jean*0610            WRITE(msgBuf,'(2A,L5)') 'ecco_check file, exst: ',
039a16fdf5 Gael*0611      &       tempfile(1:il+1),exst
a5ed45e6de An T*0612            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0613      &                  SQUEEZE_RIGHT , myThid)
f40bb882f5 Jean*0614            IF (.NOT.exst) THEN
877e0f385b An T*0615              using_gencost(k)=.FALSE.
                0616              WRITE(msgBuf,'(2A)')
69361556c2 Mart*0617      &         '** WARNING ** ECCO_CHECK: missing mask file: ',
039a16fdf5 Gael*0618      &         tempfile(1:il+1)
877e0f385b An T*0619              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0620      &                  SQUEEZE_RIGHT , myThid)
f40bb882f5 Jean*0621              il = ILNBLNK(gencost_name(k))
877e0f385b An T*0622              WRITE(msgBuf,'(3A)')
                0623      &         ' so ',gencost_name(k)(1:il),' gets switched off'
                0624              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0625      &                  SQUEEZE_RIGHT , myThid)
f40bb882f5 Jean*0626            ENDIF
a5ed45e6de An T*0627 c-- South --------------------
f40bb882f5 Jean*0628            il = ILNBLNK(gencost_mask(k))
                0629            WRITE(tempfile(1:128),'(2A)') gencost_mask(k)(1:il),'S'
039a16fdf5 Gael*0630            inquire( file=tempfile(1:il+1), exist=exst )
f40bb882f5 Jean*0631            WRITE(msgBuf,'(2A,L5)') 'ecco_check file, exst: ',
039a16fdf5 Gael*0632      &       tempfile(1:il+1),exst
a5ed45e6de An T*0633            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0634      &                  SQUEEZE_RIGHT , myThid)
f40bb882f5 Jean*0635            IF (.NOT.exst) THEN
877e0f385b An T*0636              using_gencost(k)=.FALSE.
                0637              WRITE(msgBuf,'(2A)')
69361556c2 Mart*0638      &         '** WARNING ** ECCO_CHECK: missing mask file: ',
039a16fdf5 Gael*0639      &         tempfile(1:il+1)
877e0f385b An T*0640              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0641      &                  SQUEEZE_RIGHT , myThid)
f40bb882f5 Jean*0642              il = ILNBLNK(gencost_name(k))
877e0f385b An T*0643              WRITE(msgBuf,'(3A)')
                0644      &         ' so ',gencost_name(k)(1:il),' gets switched off'
                0645              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0646      &                  SQUEEZE_RIGHT , myThid)
f40bb882f5 Jean*0647            ENDIF
                0648          ENDIF ! gencost_mask.EQ.' '
877e0f385b An T*0649 
                0650 c-- check barfile, make sure character m_tr[Vol,Heat,Salt] match exactly
                0651 c-- (upper/lower-case matters) in cost_gencost_customize
f40bb882f5 Jean*0652           IF(.NOT.( (gencost_barfile(k)(1:7).EQ.'m_trVol') .OR.
877e0f385b An T*0653      &              (gencost_barfile(k)(1:8).EQ.'m_trHeat').OR.
f40bb882f5 Jean*0654      &              (gencost_barfile(k)(1:8).EQ.'m_trSalt') )) THEN
877e0f385b An T*0655            using_gencost(k)=.FALSE.
f40bb882f5 Jean*0656            il=ILNBLNK(gencost_barfile(k))
877e0f385b An T*0657            WRITE(msgBuf,'(3A)')
                0658      &     '** WARNING ** S/R ECCO_CHECK: barfile ',
                0659      &     gencost_barfile(k)(1:il),': has no matched model var.'
                0660            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0661      &                         SQUEEZE_RIGHT, myThid )
                0662            WRITE(msgBuf,'(A)') 'Edit cost_gencost_customize to fix. '
                0663            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0664      &                         SQUEEZE_RIGHT, myThid )
f40bb882f5 Jean*0665            il = ILNBLNK(gencost_name(k))
877e0f385b An T*0666            WRITE(msgBuf,'(2A)') gencost_name(k)(1:il),' is switched off'
                0667            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0668      &                         SQUEEZE_RIGHT, myThid )
f40bb882f5 Jean*0669           ENDIF !barfile
a5ed45e6de An T*0670 c-- set using_cost_transp
f40bb882f5 Jean*0671           IF ((using_gencost(k)).AND.(gencost_flag(k).EQ.-4))
df462307fb Timo*0672      &      icount_transp=icount_transp+1
f40bb882f5 Jean*0673           IF (icount_transp.GT.0) using_cost_transp = .TRUE.
a5ed45e6de An T*0674 c-- final report to make sure using_cost_transp is set correctly
                0675           WRITE(msgBuf,'(2A,i3,L5)')
                0676      &     'ecco_check: gencost transp; icount_transp,',
                0677      &     'using_cost_transp: ',icount_transp,using_cost_transp
                0678           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0679      &                        SQUEEZE_RIGHT , myThid)
736e27304c Timo*0680 
f40bb882f5 Jean*0681          ENDIF  !gencost_flag
877e0f385b An T*0682 
f40bb882f5 Jean*0683          ENDIF !if ( gencost_datafile(k) .NE. ' ' ) THEN
                0684       ENDDO
9f3ef6a237 Gael*0685 
025a9bb173 antn*0686 c check that one of the used gencost term defines etagcm (needed in sshv4)
9f3ef6a237 Gael*0687       IF ( (using_tpj ).OR.(using_ers).OR.(using_gfo)
                0688      &     .OR.(using_mdt) ) using_cost_altim = .TRUE.
c77c347932 Gael*0689 
025a9bb173 antn*0690       igen_etagcm=0
f40bb882f5 Jean*0691       DO k=1,NGENCOST
                0692         IF ( (gencost_barfile(k)(1:5).EQ.'m_eta').AND.
025a9bb173 antn*0693      &       (using_gencost(k)) )  igen_etagcm=k
f40bb882f5 Jean*0694       ENDDO
c77c347932 Gael*0695 
025a9bb173 antn*0696       IF ((igen_etagcm.EQ.0).AND.(using_cost_altim)) THEN
22f8b844e3 Jean*0697 c warn user as we override using_cost_altim
c77c347932 Gael*0698         using_cost_altim = .FALSE.
22f8b844e3 Jean*0699         WRITE(msgBuf,'(2A)')
                0700      &    '** WARNING ** S/R ECCO_CHECK: missing file: ',
11c3150c71 Mart*0701      &    'for altimeter data so cost gets switched off'
22f8b844e3 Jean*0702         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0703      &                      SQUEEZE_RIGHT, myThid )
f40bb882f5 Jean*0704       ELSE
c77c347932 Gael*0705 c print result to screen
d4b64b229a Jean*0706         WRITE(msgBuf,'(A,I3)')
                0707      &  'etagcm defined by gencost =',igen_etagcm
                0708         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0709      &                      SQUEEZE_RIGHT, myThid )
f40bb882f5 Jean*0710       ENDIF
c77c347932 Gael*0711 
025a9bb173 antn*0712 C If more than one within the data set [tp,ers,gfo] are present, they must have
                0713 C the same avgperiod, e.g., day or month. Here we check for inconsistency:
                0714       IF (using_cost_altim) THEN
                0715        use_mon_int = 0
                0716        use_day_int = 0
                0717        IF ( using_tpj ) THEN
                0718         IF (gencost_avgperiod(igen_tp) .EQ.'month' .OR.
                0719      &      gencost_avgperiod(igen_tp) .EQ.'MONTH') THEN
                0720           use_mon_int = use_mon_int + 1
                0721         ELSE
                0722           use_day_int = use_day_int + 1
                0723         ENDIF
                0724        ENDIF
                0725        IF ( using_ers ) THEN
                0726         IF (gencost_avgperiod(igen_ers) .EQ.'month' .OR.
                0727      &      gencost_avgperiod(igen_ers) .EQ.'MONTH') THEN
                0728           use_mon_int = use_mon_int + 1
                0729         ELSE
                0730           use_day_int = use_day_int + 1
                0731         ENDIF
                0732        ENDIF
                0733        IF ( using_gfo ) THEN
                0734         IF (gencost_avgperiod(igen_gfo).EQ.'month' .OR.
                0735      &      gencost_avgperiod(igen_gfo).EQ.'MONTH' ) THEN
                0736           use_mon_int = use_mon_int + 1
                0737         ELSE
                0738           use_day_int = use_day_int + 1
                0739         ENDIF
                0740        ENDIF
                0741        IF ( use_mon_int .GT. 0 .AND. use_day_int .GT. 0 ) THEN
                0742          WRITE(msgBuf,'(2A)')
                0743      &    'ECCO_CHECK: cost sshv4: data set TP/ERS/GFO must be all ',
                0744      &    'daily or monthly, but cannot be mixed.'
                0745          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0746      &                       SQUEEZE_RIGHT, myThid )
                0747          CALL PRINT_ERROR( msgBuf, myThid )
                0748          STOP 'ABNORMAL END: S/R ECCO_CHECK'
                0749        ENDIF
                0750       ENDIF
                0751 
906a61c194 Ou W*0752 #endif /* ALLOW_GENCOST_CONTRIBUTION */
                0753 
                0754 C ============ other pkg/ecco related checks
                0755       _BEGIN_MASTER(myThid)
                0756 
                0757 #ifndef ALLOW_PSBAR_STERIC
                0758       IF (ecco_output_sterGloH) THEN
                0759          WRITE(msgBuf,'(3A)') 'ECCO_CHECK:',
                0760      &         ' Cannot set ecco_output_sterGloH to TRUE',
                0761      &         ' with #undef ALLOW_PSBAR_STERIC'
                0762          CALL PRINT_ERROR( msgBuf, myThid )
                0763          STOP 'ABNORMAL END: S/R ECCO_CHECK'
                0764       ENDIF
130273d46b Gael*0765 #endif
d4b64b229a Jean*0766 
                0767 C--   Summarize the ECCO cost function setup.
                0768       CALL ECCO_SUMMARY( myThid )
                0769 
                0770       WRITE(msgBuf,'(2A)') 'ECCO_CHECK: ',
                0771      &                     ' <-- Ends Normally'
                0772       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0773      &                    SQUEEZE_RIGHT, myThid )
                0774       WRITE(msgBuf,'(A)') ' '
                0775       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0776      &                    SQUEEZE_RIGHT, myThid )
                0777 
906a61c194 Ou W*0778       _END_MASTER(myThid)
130273d46b Gael*0779 
5001c65f45 Patr*0780       RETURN
                0781       END
984d1519c6 Gael*0782 
22f8b844e3 Jean*0783 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
984d1519c6 Gael*0784 
22f8b844e3 Jean*0785       SUBROUTINE ECCO_CHECK_FILES(
                0786      O using_cost_local,
                0787      I localname, localobsfile, localstartdate1,
984d1519c6 Gael*0788      I myThid )
22f8b844e3 Jean*0789 
                0790 C     *==========================================================*
984d1519c6 Gael*0791 C     | SUBROUTINE ECCO_CHECK_FILES                              |
                0792 C     | o Check that obs files are present for specified years.  |
                0793 C     |   If not then set using_cost_local to false.             |
22f8b844e3 Jean*0794 C     *==========================================================*
984d1519c6 Gael*0795       IMPLICIT NONE
                0796 
                0797 C     === Global variables ===
                0798 #include "SIZE.h"
                0799 #include "EEPARAMS.h"
13d362b8c1 Ou W*0800 #include "ECCO_SIZE.h"
                0801 #include "ECCO.h"
984d1519c6 Gael*0802 #ifdef ALLOW_CAL
                0803 # include "cal.h"
                0804 #endif
                0805 
                0806 C     === Routine arguments ===
                0807 C     myThid -  Number of this instances
                0808       INTEGER myThid
                0809       LOGICAL using_cost_local
f40bb882f5 Jean*0810       CHARACTER*(*) localname
                0811       CHARACTER*(MAX_LEN_FNAM) localobsfile
                0812       INTEGER localstartdate1
                0813 
                0814 c     == external functions ==
                0815       INTEGER  ILNBLNK
                0816       EXTERNAL ILNBLNK
22f8b844e3 Jean*0817 
984d1519c6 Gael*0818 C     === Local variables ===
f8e779c983 antn*0819 C     msgBuf      - Informational/error message buffer
984d1519c6 Gael*0820       CHARACTER*(MAX_LEN_MBUF) msgBuf
130273d46b Gael*0821       INTEGER irec, mody, modm, yday, locy, il
e7db56ba12 Gael*0822       LOGICAL exst, singleFileTest, yearlyFileTest
f40bb882f5 Jean*0823       CHARACTER*(128) fname
984d1519c6 Gael*0824 
                0825 c     == end of interface ==
                0826 
                0827 c left for later : refine test accounting for localstartdate1
                0828 
                0829 #ifdef ALLOW_CAL
                0830 
                0831       _BEGIN_MASTER(myThid)
                0832 
                0833       IF ( (using_cost_local).AND.(localobsfile.EQ.' ') ) THEN
                0834 c warn user as we override using_cost_local
                0835              WRITE(msgBuf,'(4A)')
                0836      &       '** WARNING ** ECCO_CHECK_FILES: missing file',
                0837      &       ' definition so ',localname,' gets switched off'
                0838              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0839      &                    SQUEEZE_RIGHT , myThid)
                0840 c switch off cost function term
                0841              using_cost_local = .FALSE.
                0842       ENDIF
                0843 
                0844       singleFileTest = .FALSE.
                0845       IF (using_cost_local) THEN
                0846            inquire( file=localobsfile, exist=exst )
                0847            IF ( exst ) singleFileTest=.TRUE.
                0848       ENDIF
                0849 
e7db56ba12 Gael*0850       yearlyFileTest = .FALSE.
22f8b844e3 Jean*0851       IF ( (using_cost_local).AND.(.NOT.singleFileTest) ) THEN
984d1519c6 Gael*0852         DO irec = 1, nmonsrec
                0853            mody   = modelstartdate(1)/10000
                0854            modm   = modelstartdate(1)/100 - mody*100
                0855            yday   = mody + INT((modm-1+irec-1)/12)
                0856 
130273d46b Gael*0857            locy   = localstartdate1/10000
                0858 
984d1519c6 Gael*0859            il=ilnblnk(localobsfile)
f40bb882f5 Jean*0860            WRITE(fname(1:128),'(2a,i4)')
984d1519c6 Gael*0861      &       localobsfile(1:il), '_', yday
                0862            inquire( file=fname, exist=exst )
                0863 
130273d46b Gael*0864            IF ( (.NOT.exst).AND.(yday.GE.locy) ) THEN
984d1519c6 Gael*0865 c warn user as we override using_cost_local
                0866              WRITE(msgBuf,'(5A)')
11c3150c71 Mart*0867      &       '** WARNING ** ECCO_CHECK_FILES: missing ',fname,
984d1519c6 Gael*0868      &       ' so ',localname,' gets switched off'
                0869              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0870      &                    SQUEEZE_RIGHT , myThid)
                0871 c switch off cost function term
                0872              using_cost_local = .FALSE.
e7db56ba12 Gael*0873            ELSEIF ( (exst).AND.(yday.GE.locy) ) THEN
                0874              yearlyFileTest = .TRUE.
984d1519c6 Gael*0875            ENDIF
                0876         ENDDO
                0877       ENDIF
e7db56ba12 Gael*0878 
                0879       IF (using_cost_local) THEN
                0880       IF ( (.NOT.yearlyFileTest).AND.(.NOT.singleFileTest) ) THEN
                0881 c warn user as we override using_cost_local
                0882              WRITE(msgBuf,'(4A)')
                0883      &       '** WARNING ** ECCO_CHECK_FILES: no data ',
                0884      &       ' so ',localname,' gets switched off'
                0885              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0886      &                    SQUEEZE_RIGHT , myThid)
                0887 c switch off cost function term
                0888              using_cost_local = .FALSE.
                0889       ENDIF
                0890       ENDIF
22f8b844e3 Jean*0891 
984d1519c6 Gael*0892       _END_MASTER(myThid)
                0893 
                0894 #endif /* ALLOW_CAL */
                0895 
                0896       RETURN
                0897       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!