Back to home page

MITgcm
 
 

    

File indexing completed on 2024-03-02 06:10:37 UTC

view on githubraw file Latest commit 5cf43646 on 2024-03-01 18:50:49 UTC
3bb97d13a4 Jean*0001 #include "GRDCHK_OPTIONS.h"
57c22ecc45 Jean*0002 #include "AD_CONFIG.h"
2091ce7ee7 Patr*0003 
1052c30783 Jean*0004       SUBROUTINE grdchk_print(
2091ce7ee7 Patr*0005      I                         ichknum,
                0006      I                         ierr_grdchk,
1052c30783 Jean*0007      I                         myThid )
                0008 
                0009 C     ==================================================================
                0010 C     SUBROUTINE grdchk_print
                0011 C     ==================================================================
                0012 C
                0013 C     o Print the results of the gradient check.
                0014 C
                0015 C     started: Christian Eckert eckert@mit.edu 08-Mar-2000
                0016 C     continued: heimbach@mit.edu: 13-Jun-2001
                0017 C
                0018 C     ==================================================================
                0019 C     SUBROUTINE grdchk_print
                0020 C     ==================================================================
                0021 
                0022       IMPLICIT NONE
                0023 
                0024 C     == global variables ==
2091ce7ee7 Patr*0025 #include "SIZE.h"
52591386bb Jean*0026 #include "EEPARAMS.h"
444da61630 Mart*0027 #include "GRDCHK.h"
2091ce7ee7 Patr*0028 
1052c30783 Jean*0029 C     == routine arguments ==
                0030       INTEGER ichknum
                0031       INTEGER ierr_grdchk
                0032       INTEGER myThid
2091ce7ee7 Patr*0033 
edd57506ae Patr*0034 #ifdef ALLOW_GRDCHK
1052c30783 Jean*0035 C     !FUNCTIONS:
                0036       INTEGER  ILNBLNK
                0037       EXTERNAL ILNBLNK
2091ce7ee7 Patr*0038 
1052c30783 Jean*0039 C     !LOCAL VARIABLES:
2091ce7ee7 Patr*0040       _RL fcref
b7ff4d81ac Patr*0041       _RL fcpertplus, fcpertminus
2091ce7ee7 Patr*0042       _RL xxmemo_ref
                0043       _RL xxmemo_pert
                0044       _RL gfd
                0045       _RL adxxmemo
22f0d78f5f Patr*0046       _RL ftlxxmemo
                0047       _RL ratio_ad
                0048       _RL ratio_ftl
7343f218d7 Jean*0049       _RL ratio_RMS
1052c30783 Jean*0050       INTEGER i
                0051       INTEGER itile
                0052       INTEGER jtile
                0053       INTEGER itilepos
                0054       INTEGER jtilepos
                0055       INTEGER layer
                0056       INTEGER icomp
                0057       INTEGER ierr
                0058       INTEGER numchecks
                0059       INTEGER iL
                0060       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0061 CEOP
                0062 
5cf4364659 Mart*0063       iL = ILNBLNK( grdchkvarname )
1052c30783 Jean*0064 
                0065 C--   Print header.
                0066       WRITE(msgBuf,'(A)') ' '
                0067       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0068      &                    SQUEEZE_RIGHT, myThid )
                0069       WRITE(msgBuf,'(A)')
                0070      & '// ======================================================='
                0071       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0072      &                    SQUEEZE_RIGHT, myThid )
                0073       WRITE(msgBuf,'(A)')
                0074      & '// Gradient check results  >>> START <<<'
                0075       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0076      &                    SQUEEZE_RIGHT, myThid)
                0077       WRITE(msgBuf,'(A)')
                0078      & '// ======================================================='
                0079       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0080      &                    SQUEEZE_RIGHT , myThid )
                0081       WRITE(msgBuf,'(A)') ' '
                0082       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0083      &                    SQUEEZE_RIGHT, myThid )
                0084 
                0085 c     WRITE(msgBuf,'(A,1PE14.6)')
                0086 c    & ' EPS = ',grdchk_eps
                0087       WRITE(msgBuf,'(A,1PE13.6,3A)')
                0088      & ' EPS =', grdchk_eps,
5cf4364659 Mart*0089      & ' ; grdchk CTRL var/file name: "',grdchkvarname(1:iL),'"'
1052c30783 Jean*0090       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0091      &                    SQUEEZE_RIGHT, myThid )
                0092       WRITE(msgBuf,'(A)') ' '
                0093       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0094      &                    SQUEEZE_RIGHT, myThid )
                0095 
                0096       WRITE(msgBuf,'(A,2X,4A,3(3X,A),11X,A)')
661d3ea730 Jean*0097      & 'grdchk output h.p:', 'Id', ' Itile', ' Jtile',
                0098      & ' LAYER', 'bi', 'bj', 'X(Id)', 'X(Id)+/-EPS'
1052c30783 Jean*0099       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0100      &                    SQUEEZE_RIGHT , myThid )
                0101       WRITE(msgBuf,'(A,2X,A,A4,1X,2A21)')
52591386bb Jean*0102      &     'grdchk output h.c:', 'Id', 'FC', 'FC1', 'FC2'
1052c30783 Jean*0103       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0104      &                    SQUEEZE_RIGHT, myThid )
78a0e1cce7 Patr*0105 #ifdef ALLOW_TANGENTLINEAR_RUN
1052c30783 Jean*0106       WRITE(msgBuf,'(A,2X,A,2X,2A18,4X,A18)')
52591386bb Jean*0107      &     'grdchk output h.g:', 'Id',
78a0e1cce7 Patr*0108      &     'FC1-FC2/(2*EPS)', 'TLM GRAD(FC)', '1-FDGRD/TLMGRD'
                0109 #else
1052c30783 Jean*0110       WRITE(msgBuf,'(A,2X,A,2X,2A18,4X,A18)')
52591386bb Jean*0111      &     'grdchk output h.g:', 'Id',
78a0e1cce7 Patr*0112      &     'FC1-FC2/(2*EPS)', 'ADJ GRAD(FC)', '1-FDGRD/ADGRD'
                0113 #endif
1052c30783 Jean*0114       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0115      &                    SQUEEZE_RIGHT, myThid )
2091ce7ee7 Patr*0116 
1052c30783 Jean*0117 C--   Individual checks.
                0118       IF ( ierr_grdchk .EQ. 0 ) THEN
78a0e1cce7 Patr*0119          numchecks = ichknum
1052c30783 Jean*0120       ELSE
2091ce7ee7 Patr*0121          numchecks = maxgrdchecks
1052c30783 Jean*0122       ENDIF
2091ce7ee7 Patr*0123 
7343f218d7 Jean*0124       ratio_RMS = 0.
1052c30783 Jean*0125       DO i = 1, numchecks
2091ce7ee7 Patr*0126         xxmemo_ref   = xxmemref  (i)
                0127         xxmemo_pert  = xxmempert (i)
                0128         adxxmemo     = adxxmem   (i)
22f0d78f5f Patr*0129         ftlxxmemo    = ftlxxmem  (i)
b7ff4d81ac Patr*0130         fcref        = fcrmem    (i)
                0131         fcpertplus   = fcppmem   (i)
78a0e1cce7 Patr*0132         fcpertminus  = fcpmmem   (i)
                0133         gfd          = gfdmem    (i)
1052c30783 Jean*0134         ratio_ad     = ratioadmem(i)
                0135         ratio_ftl    = ratioftlmem(i)
22f0d78f5f Patr*0136         itile        = bimem   (i)
                0137         jtile        = bjmem   (i)
                0138         itilepos     = ilocmem (i)
                0139         jtilepos     = jlocmem (i)
                0140         layer        = klocmem (i)
                0141         icomp        = icompmem(i)
                0142         ierr         = ierrmem (i)
2091ce7ee7 Patr*0143 
1052c30783 Jean*0144         WRITE(msgBuf,'(A)') ' '
                0145         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0146      &                      SQUEEZE_RIGHT, myThid )
                0147         WRITE(msgBuf,'(A,I4,3I6,2I5,1x,1P2E17.9)')
52591386bb Jean*0148      &       'grdchk output (p):',
661d3ea730 Jean*0149      &       i, itilepos, jtilepos, layer, itile, jtile,
2091ce7ee7 Patr*0150      &       xxmemo_ref, xxmemo_pert
1052c30783 Jean*0151         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0152      &                      SQUEEZE_RIGHT, myThid )
                0153         IF ( ierr .EQ. 0 ) THEN
                0154           WRITE(msgBuf,'(A,I4,1P3E21.13)')
52591386bb Jean*0155      &          'grdchk output (c):',
                0156      &          i, fcref, fcpertplus, fcpertminus
1052c30783 Jean*0157           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0158      &                        SQUEEZE_RIGHT, myThid )
78a0e1cce7 Patr*0159 #ifdef ALLOW_TANGENTLINEAR_RUN
cf881bc33e Jean*0160           ratio_RMS  = ratio_RMS + ratio_ftl*ratio_ftl
1052c30783 Jean*0161           WRITE(msgBuf,'(A,I4,3x,1P3E21.13)')
52591386bb Jean*0162      &          'grdchk output (g):',
                0163      &         i, gfd, ftlxxmemo, ratio_ftl
78a0e1cce7 Patr*0164 #else
7343f218d7 Jean*0165           ratio_RMS  = ratio_RMS + ratio_ad*ratio_ad
1052c30783 Jean*0166           WRITE(msgBuf,'(A,I4,3x,1P3E21.13)')
52591386bb Jean*0167      &          'grdchk output (g):',
                0168      &          i, gfd, adxxmemo, ratio_ad
78a0e1cce7 Patr*0169 #endif
1052c30783 Jean*0170           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0171      &                        SQUEEZE_RIGHT, myThid )
                0172         ELSE
                0173           IF ( ierr .EQ. -1 ) THEN
                0174            WRITE(msgBuf,'(A)') ' Component does not exist (zero)'
                0175           ELSEIF ( ierr .EQ. -2 ) THEN
                0176            WRITE(msgBuf,'(A)') ' Component does not exist (negative)'
                0177           ELSEIF ( ierr .EQ. -3 ) THEN
                0178            WRITE(msgBuf,'(A)') ' Component does not exist (too large)'
                0179           ELSEIF ( ierr .EQ. -4 ) THEN
                0180            WRITE(msgBuf,'(A)') ' Component does not exist (land point)'
                0181           ELSE
                0182            WRITE(msgBuf,'(A,I6,A)') ' Unknown error (ierr=', ierr, ' )'
                0183           ENDIF
                0184           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0185      &                        SQUEEZE_RIGHT, myThid )
                0186         ENDIF
                0187       ENDDO
                0188 
                0189 C--   Print final lines.
7343f218d7 Jean*0190       IF ( ichknum.GT.1 ) ratio_RMS = ratio_RMS / ichknum
                0191       IF ( ratio_RMS.GT.0. ) ratio_RMS = SQRT( ratio_RMS )
1052c30783 Jean*0192       WRITE(msgBuf,'(A)') ' '
                0193       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0194      &                    SQUEEZE_RIGHT, myThid )
                0195       WRITE(msgBuf,'(A,I4,A,1P1E21.13)')
7343f218d7 Jean*0196      &  'grdchk  summary  :  RMS of ',ichknum,' ratios =',ratio_RMS
1052c30783 Jean*0197       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0198      &                    SQUEEZE_RIGHT, myThid )
                0199       WRITE(msgBuf,'(A)') ' '
                0200       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0201      &                    SQUEEZE_RIGHT, myThid )
                0202       WRITE(msgBuf,'(A)')
                0203      & '// ======================================================='
                0204       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0205      &                    SQUEEZE_RIGHT, myThid )
                0206       WRITE(msgBuf,'(A)')
                0207      & '// Gradient check results  >>> END <<<'
                0208       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0209      &                    SQUEEZE_RIGHT, myThid )
                0210       WRITE(msgBuf,'(A)')
                0211      & '// ======================================================='
                0212       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0213      &                    SQUEEZE_RIGHT, myThid )
                0214       WRITE(msgBuf,'(A)') ' '
                0215       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0216      &                    SQUEEZE_RIGHT, myThid )
2091ce7ee7 Patr*0217 
edd57506ae Patr*0218 #endif /* ALLOW_GRDCHK */
2091ce7ee7 Patr*0219 
1052c30783 Jean*0220       RETURN
                0221       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!