Back to home page

darwin3
 
 

    

File indexing completed on 2024-12-17 18:38:01 UTC

view on githubraw file Latest commit d5e8791b on 2024-01-18 21:45:39 UTC
94b5b7340a Oliv*0001 #include "RADTRANS_OPTIONS.h"
                0002 #include "EXF_OPTIONS.h"
                0003 
                0004 CBOP
                0005 C !ROUTINE: RADTRANS_CHECK
                0006 
                0007 C !INTERFACE: ==========================================================
                0008       SUBROUTINE RADTRANS_CHECK( myThid )
                0009 
                0010 C !DESCRIPTION:
                0011 C     Check radtrans parameters,
                0012 
                0013 C !USES: ===============================================================
                0014       IMPLICIT NONE
                0015 #include "SIZE.h"
2c7bf51397 Oliv*0016 #include "EEPARAMS.h"
                0017 #include "PARAMS.h"
94b5b7340a Oliv*0018 #ifdef ALLOW_EXF
                0019 #include "EXF_PARAM.h"
                0020 #include "EXF_INTERP_SIZE.h"
                0021 #include "EXF_INTERP_PARAM.h"
                0022 #endif
                0023 #include "RADTRANS_SIZE.h"
                0024 #include "RADTRANS_PARAMS.h"
                0025 #include "RADTRANS_EXF_PARAMS.h"
                0026 
                0027 C !INPUT PARAMETERS: ===================================================
                0028 C  myThid               :: thread number
                0029       INTEGER myThid
                0030 
                0031 C !OUTPUT PARAMETERS: ==================================================
                0032 C  none
                0033 CEOP
                0034 
                0035 #ifdef ALLOW_RADTRANS
                0036 
2c7bf51397 Oliv*0037 C     !FUNCTIONS:
                0038       INTEGER     ILNBLNK
                0039       EXTERNAL    ILNBLNK
                0040 
94b5b7340a Oliv*0041 C !LOCAL VARIABLES: ====================================================
2c7bf51397 Oliv*0042       LOGICAL haveAny,haveAll,addBlkLn
0222db53b0 Oliv*0043       INTEGER oUnit, l, iL, errCount, cnt
94b5b7340a Oliv*0044       CHARACTER*(MAX_LEN_MBUF) msgBuf
2c7bf51397 Oliv*0045       CHARACTER*1 blkLin
94b5b7340a Oliv*0046 
                0047       _BEGIN_MASTER(myThid)
                0048 
                0049 C ======================================================================
2c7bf51397 Oliv*0050 C     check for errors in configuration
94b5b7340a Oliv*0051 
                0052 C ----------------------------------------------------------------------
2c7bf51397 Oliv*0053 C     check for unsupported forcing configurations
                0054       errCount = 0
                0055       IF ( useExfYearlyFields ) THEN
                0056        IF ( RT_E_RepCycle.NE.0. ) THEN
                0057         WRITE(msgBuf,'(2A)') 'RADTRANS_CHECK: The use of ',
                0058      &       'useExfYearlyFields AND RT_E_RepCycle is not implemented'
                0059         CALL PRINT_ERROR( msgBuf, myThid )
                0060         errCount = errCount + 1
                0061        ENDIF
                0062        IF ( RT_iceRepCycle.NE.0. ) THEN
                0063         WRITE(msgBuf,'(2A)') 'RADTRANS_CHECK: The use of ',
                0064      &       'useExfYearlyFields AND RT_iceRepCycle is not implemented'
                0065         CALL PRINT_ERROR( msgBuf, myThid )
                0066         errCount = errCount + 1
                0067        ENDIF
                0068       ENDIF
                0069       IF ( errCount.GE.1 ) THEN
                0070         WRITE(msgBuf,'(A,I3,A)')
                0071      &     'RADTRANS_CHECK: detected', errCount,' fatal error(s)'
                0072         CALL PRINT_ERROR( msgBuf, myThid )
                0073         CALL ALL_PROC_DIE( 0 )
                0074         STOP 'ABNORMAL END: S/R RADTRANS_CHECK'
94b5b7340a Oliv*0075       ENDIF
1c7c72345b Oliv*0076 
                0077 C ----------------------------------------------------------------------
                0078 C     need sun package unless using mean cos(solz)
2c7bf51397 Oliv*0079 
1c7c72345b Oliv*0080 #ifndef ALLOW_SUN
0222db53b0 Oliv*0081       IF (.NOT.(RT_useMeanCosSolz.OR.RT_useOASIMrmud)) THEN
d5e8791b43 Oliv*0082         WRITE(msgBuf,'(2A)') 'RADTRANS_CHECK: need to compile the sun ',
0222db53b0 Oliv*0083      &   'package unless RT_useMeanCosSolz or oasim pkg is used.'
1c7c72345b Oliv*0084         CALL PRINT_ERROR( msgBuf, myThid )
                0085         CALL ALL_PROC_DIE( 0 )
                0086         STOP 'ABNORMAL END: S/R RADTRANS_CHECK'
                0087       ENDIF
                0088 #endif
                0089 
2c7bf51397 Oliv*0090 C ----------------------------------------------------------------------
                0091 C     requirements for various solar zenith angle definitions
                0092 
0222db53b0 Oliv*0093       IF (RT_useOASIMrmud .AND. .NOT.useOASIM) THEN
                0094         WRITE(msgBuf,'(2A)') 'RADTRANS_CHECK: ',
                0095      &       'RT_useOASIMrmud requires the OASIM package'
                0096         CALL PRINT_ERROR( msgBuf, myThid )
                0097         CALL ALL_PROC_DIE( 0 )
                0098         STOP 'ABNORMAL END: S/R RADTRANS_CHECK'
                0099       ENDIF
                0100 
                0101       IF (useOASIM .AND. .NOT.RT_useOASIMrmud) THEN
e8b7a8749d Oliv*0102         WRITE(msgBuf,'(2A)') '** WARNING ** RADTRANS_CHECK: ',
0222db53b0 Oliv*0103      &       'RT_useOASIMrmud=.FALSE. but is recommended with useOASIM'
                0104         CALL PRINT_MESSAGE(msgBuf,errorMessageUnit,SQUEEZE_RIGHT,myThid)
                0105       ENDIF
                0106 
                0107 C     make sure only on solz option is set
                0108       cnt = 0
                0109       IF (RT_useOASIMrmud) cnt = cnt + 1
                0110       IF (RT_useMeanCosSolz) cnt = cnt + 1
                0111       IF (RT_useNoonSolz) cnt = cnt + 1
                0112       IF (cnt .GT. 1) THEN
                0113         WRITE(msgBuf,'(2A)') 'RADTRANS_CHECK: only one of ',
                0114      &  'RT_useOASIMrmud, RT_useMeanCosSolz, RT_useNoonSolz can be set'
e8b7a8749d Oliv*0115         CALL PRINT_ERROR( msgBuf, myThid )
                0116         CALL ALL_PROC_DIE( 0 )
                0117         STOP 'ABNORMAL END: S/R RADTRANS_CHECK'
                0118       ENDIF
                0119 
94b5b7340a Oliv*0120 C ----------------------------------------------------------------------
                0121 C     check for unsupported forcing configurations
                0122       errCount = 0
                0123       IF ( useExfYearlyFields ) THEN
                0124        IF ( RT_E_RepCycle.NE.0. ) THEN
                0125         WRITE(msgBuf,'(2A)') 'RADTRANS_CHECK: The use of ',
                0126      &       'useExfYearlyFields AND RT_E_RepCycle is not implemented'
                0127         CALL PRINT_ERROR( msgBuf, myThid )
                0128         errCount = errCount + 1
                0129        ENDIF
                0130        IF ( RT_iceRepCycle.NE.0. ) THEN
                0131         WRITE(msgBuf,'(2A)') 'RADTRANS_CHECK: The use of ',
                0132      &       'useExfYearlyFields AND RT_iceRepCycle is not implemented'
                0133         CALL PRINT_ERROR( msgBuf, myThid )
                0134         errCount = errCount + 1
                0135        ENDIF
                0136       ENDIF
                0137       IF ( errCount.GE.1 ) THEN
                0138         WRITE(msgBuf,'(A,I3,A)')
                0139      &     'RADTRANS_CHECK: detected', errCount,' fatal error(s)'
                0140         CALL PRINT_ERROR( msgBuf, myThid )
                0141         CALL ALL_PROC_DIE( 0 )
                0142         STOP 'ABNORMAL END: S/R RADTRANS_CHECK'
                0143       ENDIF
                0144 
2c7bf51397 Oliv*0145 C ======================================================================
                0146 
                0147       blkLin = ' '
                0148 
                0149 C ======================================================================
                0150 C     write waveband detail to standard output
                0151 
                0152       WRITE(msgBuf,'(A)') 'RADTRANS_CHECK: #define ALLOW_RADTRANS'
                0153       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0154      &                    SQUEEZE_RIGHT, 1 )
                0155       CALL PRINT_MESSAGE( blkLin, standardMessageUnit,
                0156      &                    SQUEEZE_RIGHT , myThid )
                0157 
                0158       WRITE(msgBuf,'(A)') 'RADTRANS_CHECK: wavebands:'
                0159       CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,
                0160      &                   SQUEEZE_RIGHT,myThid)
                0161       WRITE(msgBuf,'(2A)') 'RADTRANS_CHECK: ',
                0162      &   ' idx       low   rep      high    width'
                0163       CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,
                0164      &                   SQUEEZE_RIGHT,myThid)
                0165       DO l=1,nlam
                0166         WRITE(msgBuf,'(A,I4,F10.3,F6.0,F10.3,F9.3)')
                0167      &  'RADTRANS_CHECK: ', l, RT_wbEdges(l),
                0168      &  RT_wbRefWLs(l),RT_wbEdges(l+1),RT_wbWidths(l)
                0169         CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,
                0170      &                   SQUEEZE_RIGHT,myThid)
                0171       ENDDO
                0172       CALL PRINT_MESSAGE( blkLin, standardMessageUnit,
                0173      &                    SQUEEZE_RIGHT , myThid )
                0174 
                0175 C ----------------------------------------------------------------------
                0176 C     and to separate text file
                0177       IF ( myProcId.EQ.0 .AND. myThid.EQ.1 ) THEN
                0178         CALL MDSFINDUNIT( oUnit, myThid )
                0179         OPEN(oUnit,file='pwaves-check.dat',status='unknown')
                0180         WRITE(oUnit,'(F6.0)')RT_wbRefWLs
                0181         CLOSE(oUnit)
                0182       ENDIF
                0183 
                0184 C ======================================================================
                0185 
                0186 C--   RT_E
                0187 
                0188       addBlkLn = .FALSE.
                0189 
87dd4f7d5f Oliv*0190       IF ( .NOT.useOASIM ) THEN
                0191        haveAny = .FALSE.
                0192        haveAll = .FALSE.
                0193        DO l=1,nlam
                0194         IF ( RT_EdFile(l).EQ.' ' ) THEN
                0195          haveAll = .FALSE.
                0196         ELSE
                0197          haveAny = .TRUE.
                0198          WRITE(msgBuf,'(A,I3.3,A)')'RT_Ed',l,' forcing'
                0199          iL = ILNBLNK(msgBuf)
                0200          CALL EXF_FLD_SUMMARY( msgBuf(1:iL),
                0201      I        RT_EdFile(l), RT_E_RepCycle, RT_E_period,
                0202      I        RT_E_StartTime, useExfYearlyFields, addBlkLn, myThid )
                0203         ENDIF
                0204        ENDDO
2c7bf51397 Oliv*0205 
                0206        CALL PRINT_MESSAGE( blkLin, standardMessageUnit,
                0207      &                     SQUEEZE_RIGHT , myThid )
                0208 
87dd4f7d5f Oliv*0209        DO l=1,nlam
                0210         IF ( RT_EsFile(l).EQ.' ' ) THEN
                0211          haveAll = .FALSE.
                0212         ELSE
                0213          haveAny = .TRUE.
                0214          WRITE(msgBuf,'(A,I3.3,A)')'RT_Es',l,' forcing'
                0215          iL = ILNBLNK(msgBuf)
                0216          CALL EXF_FLD_SUMMARY( msgBuf(1:iL),
                0217      I        RT_EsFile(l), RT_E_RepCycle, RT_E_period,
                0218      I        RT_E_StartTime, useExfYearlyFields, addBlkLn, myThid )
                0219         ENDIF
                0220        ENDDO
                0221 
                0222        IF (haveAny) THEN
                0223         CALL PRINT_MESSAGE( blkLin, standardMessageUnit,
                0224      &                      SQUEEZE_RIGHT , myThid )
                0225         CALL WRITE_1D_RL(RT_Ed_exfremo_intercept,nlam,INDEX_NONE,
                0226      &   'RT_Ed_exfremo_intercept =',
                0227      &   ' /* intercept for RT_Ed forcing mean removal */')
                0228         CALL WRITE_1D_RL(RT_Ed_exfremo_slope,nlam,INDEX_NONE,
                0229      &   'RT_Ed_exfremo_slope =',
                0230      &   ' /* slope for RT_Ed forcing trend removal */')
                0231         CALL WRITE_1D_RL(RT_inscal_Ed,nlam,INDEX_NONE,
                0232      &   'RT_inscal_Ed =',
                0233      &   ' /* scaling factor for RT_Ed fields */')
                0234 
                0235         CALL PRINT_MESSAGE( blkLin, standardMessageUnit,
                0236      &                      SQUEEZE_RIGHT , myThid )
                0237 
                0238         CALL WRITE_1D_RL(RT_Es_exfremo_intercept,nlam,INDEX_NONE,
                0239      &   'RT_Es_exfremo_intercept =',
                0240      &   ' /* intercept for RT_Es forcing mean removal */')
                0241         CALL WRITE_1D_RL(RT_Es_exfremo_slope,nlam,INDEX_NONE,
                0242      &   'RT_Es_exfremo_slope =',
                0243      &   ' /* slope for RT_Es forcing trend removal */')
                0244         CALL WRITE_1D_RL(RT_inscal_Es,nlam,INDEX_NONE,
                0245      &   'RT_inscal_Es =',
                0246      &   ' /* scaling factor for RT_Es fields */')
                0247        ENDIF
                0248        IF (.NOT.haveAll) THEN
                0249         CALL WRITE_1D_RL(RT_Ed_const,nlam,INDEX_NONE,
                0250      &   'RT_Ed_const =',
                0251      &   ' /* constant RT_Ed forcing */')
                0252         CALL WRITE_1D_RL(RT_Es_const,nlam,INDEX_NONE,
                0253      &   'RT_Es_const =',
                0254      &   ' /* constant RT_Es forcing */')
                0255        ENDIF
2c7bf51397 Oliv*0256 
87dd4f7d5f Oliv*0257        CALL WRITE_0D_C(RT_E_mask,-1,INDEX_NONE,
                0258      &   'RT_E_mask =',
                0259      &   ' /* mask for RT_E forcing */')
2c7bf51397 Oliv*0260 
87dd4f7d5f Oliv*0261 C     endif .NOT.useOASIM
                0262       ENDIF
2c7bf51397 Oliv*0263 
                0264       CALL PRINT_MESSAGE( blkLin, standardMessageUnit,
                0265      &                     SQUEEZE_RIGHT , myThid )
                0266 
                0267 C--   ice
                0268       IF ( RT_icefile.NE.' ' ) THEN
                0269        CALL EXF_FLD_SUMMARY( 'RT_ice forcing',
                0270      I      RT_icefile, RT_iceRepCycle, RT_iceperiod,
                0271      I      RT_iceStartTime, useExfYearlyFields, addBlkLn, myThid )
                0272        CALL PRINT_MESSAGE( blkLin, standardMessageUnit,
                0273      &                     SQUEEZE_RIGHT , myThid )
                0274        CALL WRITE_0D_RL(RT_ice_exfremo_intercept,INDEX_NONE,
                0275      &   'RT_ice_exfremo_intercept =',
                0276      &   ' /* intercept for RT_ice forcing mean removal */')
                0277        CALL WRITE_0D_RL(RT_ice_exfremo_slope,INDEX_NONE,
                0278      &   'RT_ice_exfremo_slope =',
                0279      &   ' /* slope for RT_ice forcing trend removal */')
                0280        CALL WRITE_0D_RL(RT_inscal_ice,INDEX_NONE,
                0281      &   'RT_inscal_ice =',
                0282      &   ' /* scaling factor for RT_ice fields */')
                0283       ELSE
                0284        CALL WRITE_0D_RL(RT_iceconst,INDEX_NONE,
                0285      &   'RT_iceconst =',
                0286      &   ' /* constant RT_ice forcing */')
                0287       ENDIF
                0288 
                0289       IF ( RT_icefile.NE.' ' .OR. RT_iceconst.NE.0D0 ) THEN
                0290        CALL WRITE_0D_C(RT_icemask,-1,INDEX_NONE,
                0291      &   'RT_icemask =',
                0292      &   ' /* mask for RT_ice forcing */')
                0293       ENDIF
                0294 
                0295       CALL PRINT_MESSAGE( blkLin, standardMessageUnit,
                0296      &                     SQUEEZE_RIGHT , myThid )
                0297 
                0298       CALL WRITE_0D_RL(RT_refract_water,INDEX_NONE,
                0299      &'RT_refract_water =',
                0300      &' /* refractive index of water */')
                0301       CALL WRITE_0D_RL(RT_rmud_max,INDEX_NONE,
                0302      &'RT_rmud_max =',
                0303      &' /* cutoff for inverse cosine of solar zenith angle */')
                0304       CALL WRITE_1D_RL(RT_wbEdges,nlam,INDEX_NONE,
                0305      &'RT_wbEdges =',
                0306      &' /* waveband edges [nm] */')
                0307       CALL WRITE_1D_RL(RT_wbRefWLs,nlam,INDEX_NONE,
                0308      &'RT_wbRefWLs =',
                0309      &' /* reference wavelengths for wavebands [nm] */')
                0310       CALL WRITE_1D_RL(RT_wbWidths,nlam,INDEX_NONE,
                0311      &'RT_wbWidths =',
                0312      &' /* waveband widths [nm] */')
                0313       CALL WRITE_0D_RL(RT_wbTotalWidth,INDEX_NONE,
                0314      &'RT_wbTotalWidth =',
                0315      &' /* total width of all wavebands [nm] */')
                0316       CALL WRITE_0D_I(RT_kmax,INDEX_NONE,
                0317      &'RT_kmax =',
                0318      &' /* maximum depth index for radtrans computations */')
0222db53b0 Oliv*0319       CALL WRITE_0D_L(RT_useOASIMrmud,INDEX_NONE,
                0320      &'RT_useOASIMrmud =',
                0321      &' /* use mean solar zenith angle from OASIM */')
2c7bf51397 Oliv*0322       CALL WRITE_0D_L(RT_useMeanCosSolz,INDEX_NONE,
                0323      &'RT_useMeanCosSolz =',
                0324      &' /* flag for using mean daytime cosine of solar zenith angle */')
                0325       CALL WRITE_0D_L(RT_useNoonSolz,INDEX_NONE,
                0326      &'RT_useNoonSolz =',
                0327      &' /* flag for using noon solar zenith angle */')
                0328       CALL WRITE_0D_RL(RT_sfcIrrThresh,INDEX_NONE,
                0329      &'RT_sfcIrrThresh =',
                0330      &' /* minimum irradiance for radiative transfer computations */')
0222db53b0 Oliv*0331       CALL WRITE_1D_RL(RT_oasimWgt,nlam,INDEX_NONE,
                0332      &'RT_oasimWgt =',
                0333      &' /* weight multiplying each waveband from OASIM */')
2c7bf51397 Oliv*0334       CALL WRITE_0D_RL(RT_rmus,INDEX_NONE,
                0335      &'RT_rmus =',
                0336      &' /* mean inv. cosine of zenith angle for dwnwrd diff. irr. */')
                0337       CALL WRITE_0D_RL(RT_rmuu,INDEX_NONE,
                0338      &'RT_rmuu =',
                0339      &' /* mean inv. cosine of zenith angle for upward diff. irr. */')
                0340       CALL WRITE_0D_RL(RT_rd,INDEX_NONE,
                0341      &'RT_rd =',
                0342      &' /* mean upward scattering fraction for downward diff. irr. */')
                0343       CALL WRITE_0D_RL(RT_ru,INDEX_NONE,
                0344      &'RT_ru =',
                0345      &' /* mean downward scattering fraction for upward diff. irr. */')
                0346       CALL WRITE_0D_L(RT_useSEAICE,INDEX_NONE,
                0347      &'RT_useSEAICE =',
                0348      &' /* use ice fraction from seaice package */')
                0349       CALL WRITE_0D_L(RT_haveIce,INDEX_NONE,
                0350      &'RT_haveIce =',
                0351      &' /* whether iceFile iceConst have been provided */')
                0352       CALL WRITE_1D_RL(RT_WtouEins,nlam,INDEX_NONE,
                0353      &'RT_WtouEins =',
                0354      &' /* conversion factors for irradiance to PAR */')
                0355 
94b5b7340a Oliv*0356 C ----------------------------------------------------------------------
                0357       _END_MASTER(myThid)
                0358 
                0359 C Everyone else must wait for the parameters to be loaded
                0360       _BARRIER
                0361 
                0362 #endif /* ALLOW_RADTRANS */
                0363 
                0364       RETURN
                0365       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

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

The LXR team
Valid CSS 2.1! Valid HTML 4.01!