Back to home page

MITgcm
 
 

    

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

view on githubraw file Latest commit 69361556 on 2026-03-18 21:20:20 UTC
7bfe6112e8 Jean*0001 #include "CTRL_OPTIONS.h"
7109a141b2 Patr*0002 
4d72283393 Mart*0003       subroutine ctrl_Summary( myThid )
7109a141b2 Patr*0004 
                0005 c     ==================================================================
                0006 c     SUBROUTINE ctrl_Summary
                0007 c     ==================================================================
                0008 c
219393e304 Gael*0009 c     o Summarize the control vector settings.
7109a141b2 Patr*0010 c
                0011 c     ==================================================================
                0012 c     SUBROUTINE ctrl_Summary
                0013 c     ==================================================================
                0014 
5cf4364659 Mart*0015       IMPLICIT NONE
7109a141b2 Patr*0016 
                0017 c     == global variables ==
                0018 
                0019 #include "EEPARAMS.h"
                0020 #include "SIZE.h"
6b47d550f4 Mart*0021 #include "PARAMS.h"
7109a141b2 Patr*0022 
dff4940422 Patr*0023 #ifdef ALLOW_CAL
7109a141b2 Patr*0024 # include "cal.h"
                0025 #endif
b6f5c14800 Gael*0026 #ifdef ALLOW_AUTODIFF
                0027 # include "AUTODIFF_PARAMS.h"
                0028 #endif
ea1c7c7217 Gael*0029 #ifdef ALLOW_CTRL
                0030 # include "CTRL_SIZE.h"
5cf4364659 Mart*0031 # include "CTRL.h"
                0032 # if (   defined ALLOW_GENARR2D_CONTROL \
                0033       || defined ALLOW_GENARR3D_CONTROL \
                0034       || defined ALLOW_GENTIM2D_CONTROL  )
ea1c7c7217 Gael*0035 #  include "CTRL_GENARR.h"
                0036 # endif
69361556c2 Mart*0037 # ifdef ALLOW_OBCS
                0038 #  include "CTRL_OBCS.h"
                0039 # endif
ea1c7c7217 Gael*0040 #endif
7109a141b2 Patr*0041 
                0042 c     == routine arguments ==
4d72283393 Mart*0043       integer myThid
7109a141b2 Patr*0044 
9f5240b52a Jean*0045 c     == external ==
                0046       integer  ilnblnk
                0047       external ilnblnk
7109a141b2 Patr*0048 
9f5240b52a Jean*0049 c     == local variables ==
7109a141b2 Patr*0050       integer bi,bj
9f5240b52a Jean*0051       integer k
5cf4364659 Mart*0052       integer ivar
7109a141b2 Patr*0053       integer il
5cf4364659 Mart*0054       integer errCount
7109a141b2 Patr*0055       integer nwetcenter
                0056       integer nwetsouth
                0057       integer nwetwest
                0058 
0e6a4460e5 Ivan*0059       character*(MAX_LEN_MBUF) msgbuf
7109a141b2 Patr*0060 
cf705a6c8e Mart*0061 #if (defined (ALLOW_GENARR2D_CONTROL) \
                0062       || defined (ALLOW_GENARR3D_CONTROL) \
                0063       || defined (ALLOW_GENTIM2D_CONTROL))
5cf4364659 Mart*0064       INTEGER iarr, jarr, iw
ea1c7c7217 Gael*0065 #endif
cf705a6c8e Mart*0066 #if ( defined ALLOW_GENTIM2D_CONTROL && defined ALLOW_CAL )
9f5240b52a Jean*0067       integer i, timeint(4)
                0068 #endif
7109a141b2 Patr*0069 
                0070 c     == end of interface ==
                0071 
5cf4364659 Mart*0072       errCount = 0
                0073 
                0074       write(msgbuf,'(a)') ' '
4d72283393 Mart*0075       call print_message( msgbuf, standardMessageUnit,
                0076      &                    SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0077       write(msgbuf,'(a)')
                0078      &'// ======================================================='
4d72283393 Mart*0079       call print_message( msgbuf, standardMessageUnit,
                0080      &                    SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0081       write(msgbuf,'(a)')
219393e304 Gael*0082      &'// control vector configuration  >>> START <<<'
4d72283393 Mart*0083       call print_message( msgbuf, standardMessageUnit,
                0084      &                    SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0085       write(msgbuf,'(a)')
                0086      &'// ======================================================='
4d72283393 Mart*0087       call print_message( msgbuf, standardMessageUnit,
                0088      &                    SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0089       write(msgbuf,'(a)') ' '
4d72283393 Mart*0090       call print_message( msgbuf, standardMessageUnit,
                0091      &                    SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0092 
                0093       write(msgbuf,'(a)')
                0094      &' Total number of ocean points per tile:'
4d72283393 Mart*0095       call print_message( msgbuf, standardMessageUnit,
                0096      &                    SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0097       write(msgbuf,'(a)')
                0098      &' --------------------------------------'
4d72283393 Mart*0099       call print_message( msgbuf, standardMessageUnit,
                0100      &                    SQUEEZE_RIGHT, myThid )
                0101       write(msgbuf,'(a,i8)') ' sNx*sNy*Nr = ',sNx*sNy*Nr
                0102       call print_message( msgbuf, standardMessageUnit,
                0103      &                    SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0104       write(msgbuf,'(a)') ' '
4d72283393 Mart*0105       call print_message( msgbuf, standardMessageUnit,
                0106      &                    SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0107       write(msgbuf,'(a)')
                0108      &' Number of ocean points per tile:'
4d72283393 Mart*0109       call print_message( msgbuf, standardMessageUnit,
                0110      &                    SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0111       write(msgbuf,'(a)')
                0112      &' --------------------------------'
4d72283393 Mart*0113       call print_message( msgbuf, standardMessageUnit,
                0114      &                    SQUEEZE_RIGHT, myThid )
                0115       do bj = 1,nSy
                0116         do bi = 1,nSx
7109a141b2 Patr*0117           nwetcenter = 0
                0118           nwetsouth  = 0
                0119           nwetwest   = 0
4d72283393 Mart*0120           do k = 1,Nr
7109a141b2 Patr*0121             nwetcenter = nwetcenter + nwetctile(bi,bj,k)
                0122             nwetsouth  = nwetsouth  + nwetstile(bi,bj,k)
                0123             nwetwest   = nwetwest   + nwetwtile(bi,bj,k)
                0124           enddo
5cf4364659 Mart*0125 c         write(msgbuf,'(a,i5.4,i5.4,i7.6,i7.6,i7.6)')
                0126           write(msgbuf,'(a,i4.3,i4.3,i8,i8,i8)')
                0127      &    ' bi,bj,#(c/s/w):',bi,bj,nwetcenter, nwetsouth, nwetwest
4d72283393 Mart*0128           call print_message( msgbuf, standardMessageUnit,
                0129      &                        SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0130         enddo
                0131       enddo
                0132 
5cf4364659 Mart*0133       do ivar = 1, maxcvars
0e6a4460e5 Ivan*0134 C     only print active variables for which ncvarindex has been set
5cf4364659 Mart*0135 C     (default = -1)
                0136        if ( ncvarindex(ivar) .GE. 0 ) then
ea1c7c7217 Gael*0137 
5cf4364659 Mart*0138         write(msgbuf,'(a)') ' '
4d72283393 Mart*0139         call print_message( msgbuf, standardMessageUnit,
                0140      &                      SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0141         il   = ILNBLNK( ncvarfname(ivar) )
                0142 C     find out if current variable is a generic control variable name
                0143 #ifdef ALLOW_GENARR3D_CONTROL
                0144         if ( ncvartype(ivar) .eq. 'Arr3D') then
                0145          iarr = ncvarindex(ivar)
                0146          if ( xx_genarr3d_file(iarr) .eq. ncvarfname(ivar) ) then
                0147           write(msgbuf,'(a,i3,a)')
                0148      &    ' -> 3d control, genarr3d no.',iarr,' is in use'
4d72283393 Mart*0149           call print_message( msgbuf, standardMessageUnit,
                0150      &                        SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0151          else
                0152           write(msgbuf,'(a,i6)')
                0153      &    ' -> something is wrong with 3d control, genarr3d no.',iarr
                0154           call print_error( msgbuf, myThid )
                0155           errCount = errCount + 1
6b47d550f4 Mart*0156          endif
5cf4364659 Mart*0157         endif
ea1c7c7217 Gael*0158 #endif
5cf4364659 Mart*0159 #ifdef ALLOW_GENARR2D_CONTROL
                0160         if ( ncvartype(ivar) .eq. 'Arr2D') then
                0161          iarr = ncvarindex(ivar)
                0162          if ( xx_genarr2d_file(iarr) .eq. ncvarfname(ivar) ) then
                0163           write(msgbuf,'(a,i3,a)')
                0164      &    ' -> 2d control, genarr2d no.',iarr,' is in use'
4d72283393 Mart*0165           call print_message( msgbuf, standardMessageUnit,
                0166      &                        SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0167          else
                0168           write(msgbuf,'(a,i6)')
                0169      &    ' -> something is wrong with 2d control, genarr2d no.',iarr
                0170           call print_error( msgbuf, myThid )
                0171           errCount = errCount + 1
6b47d550f4 Mart*0172          endif
5cf4364659 Mart*0173         endif
ea1c7c7217 Gael*0174 #endif
                0175 #ifdef ALLOW_GENTIM2D_CONTROL
5cf4364659 Mart*0176         if ( ncvartype(ivar) .eq. 'Tim2D') then
                0177          iarr = ncvarindex(ivar)
                0178          if ( xx_gentim2d_file(iarr) .eq. ncvarfname(ivar) ) then
                0179           write(msgbuf,'(2a,i3,a)') ' -> ',
                0180      &    'time variable 2d control, gentim2d no.',iarr,' is in use'
                0181           call print_message( msgbuf, standardMessageUnit,
                0182      &                        SQUEEZE_RIGHT, myThid )
                0183          else
                0184           write(msgbuf,'(2a,i6)') ' -> something is wrong with ',
                0185      &    'time variable  2d control, gentim2d no.',iarr
                0186           call print_error( msgbuf, myThid )
                0187           errCount = errCount + 1
                0188          endif
                0189         endif
                0190 #endif
ea1c7c7217 Gael*0191         write(msgbuf,'(a,a)')
5cf4364659 Mart*0192      &'      file       = ',ncvarfname(ivar)(1:il)
4d72283393 Mart*0193         call print_message( msgbuf, standardMessageUnit,
                0194      &                      SQUEEZE_RIGHT, myThid )
ea1c7c7217 Gael*0195         write(msgbuf,'(a,a)')
5cf4364659 Mart*0196      &'      ncvartype  = ', ncvartype(ivar)
4d72283393 Mart*0197         call print_message( msgbuf, standardMessageUnit,
                0198      &                      SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0199         write(msgbuf,'(a,i5,a)')
                0200      &'      index      = ', ivar, '  (use this for pkg/grdchk)'
4d72283393 Mart*0201         call print_message( msgbuf, standardMessageUnit,
                0202      &                      SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0203         write(msgbuf,'(a,i5)')
                0204      &'      ncvarindex = ', ncvarindex(ivar)
4d72283393 Mart*0205         call print_message( msgbuf, standardMessageUnit,
                0206      &                      SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0207 C     extra information only available for generic control variables
                0208 #ifdef ALLOW_GENARR3D_CONTROL
                0209         if ( ncvartype(ivar) .eq. 'Arr3D') then
                0210          iarr = ncvarindex(ivar)
                0211          iw   = ILNBLNK( xx_genarr3d_weight(iarr) )
                0212          write(msgbuf,'(a,a)')
                0213      &'      weight     = ',xx_genarr3d_weight(iarr)(1:iw)
4d72283393 Mart*0214          call print_message( msgbuf, standardMessageUnit,
                0215      &                       SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0216          do jarr=1,maxCtrlProc
                0217           if (xx_genarr3d_preproc(jarr,iarr).NE.' ') then
                0218            il = ilnblnk(xx_genarr3d_preproc(jarr,iarr))
                0219            write(msgbuf,'(a,a)') ' preprocess = ',
                0220      &          xx_genarr3d_preproc(jarr,iarr)(1:il)
4d72283393 Mart*0221            call print_message( msgbuf, standardMessageUnit,
                0222      &                         SQUEEZE_RIGHT, myThid )
513e004a84 Gael*0223           endif
5cf4364659 Mart*0224          enddo
                0225         endif
                0226 #endif
                0227 #ifdef ALLOW_GENARR2D_CONTROL
                0228         if ( ncvartype(ivar) .eq. 'Arr2D' ) then
                0229          iarr = ncvarindex(ivar)
                0230          iw   = ILNBLNK( xx_genarr2d_weight(iarr) )
                0231          write(msgbuf,'(a,a)')
                0232      &'      weight     = ',xx_genarr2d_weight(iarr)(1:iw)
                0233          call print_message( msgbuf, standardMessageUnit,
                0234      &                       SQUEEZE_RIGHT, myThid )
                0235          do jarr=1,maxCtrlProc
                0236           if (xx_genarr2d_preproc(jarr,iarr).NE.' ') then
                0237            il = ilnblnk(xx_genarr2d_preproc(jarr,iarr))
                0238            write(msgbuf,'(a,a)') ' preprocess = ',
                0239      &          xx_genarr2d_preproc(jarr,iarr)(1:il)
4d72283393 Mart*0240            call print_message( msgbuf, standardMessageUnit,
                0241      &                         SQUEEZE_RIGHT, myThid )
4d1f3cfa6a Gael*0242           endif
5cf4364659 Mart*0243          enddo
                0244         endif
                0245 #endif
                0246 #ifdef ALLOW_GENTIM2D_CONTROL
                0247         if ( ncvartype(ivar) .eq. 'Tim2D' ) then
                0248          iarr = ncvarindex(ivar)
                0249          iw   = ILNBLNK( xx_gentim2d_weight(iarr) )
                0250          write(msgbuf,'(a,a)')
                0251      &'      weight     = ',xx_gentim2d_weight(iarr)(1:iw)
                0252          call print_message( msgbuf, standardMessageUnit,
                0253      &                       SQUEEZE_RIGHT, myThid )
                0254 #ifdef ALLOW_CAL
                0255          if ( useCAL ) then
                0256           call cal_TimeInterval( xx_gentim2d_period(iarr),
                0257      &                          'secs', timeint, myThid )
                0258           write(msgbuf,'(a,i9.8,i7.6)')
                0259      &'      period     = ',(timeint(i), i=1,2)
                0260           call print_message( msgbuf, standardMessageUnit,
                0261      &                        SQUEEZE_RIGHT, myThid )
                0262          endif
                0263 #endif
                0264 
                0265          do jarr=1,maxCtrlProc
                0266           if (xx_gentim2d_preproc(jarr,iarr).NE.' ') then
                0267            il = ilnblnk(xx_gentim2d_preproc(jarr,iarr))
                0268            write(msgbuf,'(a,a)') '      preprocess = ',
                0269      &          xx_gentim2d_preproc(jarr,iarr)(1:il)
4d72283393 Mart*0270            call print_message( msgbuf, standardMessageUnit,
                0271      &                         SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0272 C
                0273            if (xx_gentim2d_preproc_c(jarr,iarr).NE.' ') then
                0274             il = ilnblnk(xx_gentim2d_preproc_c(jarr,iarr))
                0275             write(msgbuf,'(a,a)') '        param. (text)= ',
                0276      &           xx_gentim2d_preproc_c(jarr,iarr)(1:il)
                0277             call print_message( msgbuf, standardMessageUnit,
                0278      &                          SQUEEZE_RIGHT, myThid )
                0279            endif
                0280 C
                0281            if (xx_gentim2d_preproc_i(jarr,iarr).NE.0) then
                0282             write(msgbuf,'(a,i6)') '        param. (int.)= ',
                0283      &           xx_gentim2d_preproc_i(jarr,iarr)
                0284             call print_message( msgbuf, standardMessageUnit,
                0285      &                          SQUEEZE_RIGHT, myThid )
                0286            endif
                0287 C
                0288            if (xx_gentim2d_preproc_r(jarr,iarr).NE.0. _d 0) then
                0289             write(msgbuf,'(a,e10.3)') '        param. (real)= ',
                0290      &           xx_gentim2d_preproc_r(jarr,iarr)
                0291             call print_message( msgbuf, standardMessageUnit,
                0292      &                          SQUEEZE_RIGHT, myThid )
                0293            endif
513e004a84 Gael*0294 
5cf4364659 Mart*0295           endif
                0296          enddo
                0297         endif
                0298 #endif
ea1c7c7217 Gael*0299        endif
                0300       enddo
                0301 
5cf4364659 Mart*0302       if ( errCount.GE.1 ) then
                0303         write(msgbuf,'(a,i3,a)')
                0304      &       'ctrl_summary: detected', errCount,' fatal error(s)'
                0305         call print_error( msgbuf, myThid )
                0306         stop 'ABNORMAL END: S/R CTRL_SUMMARY'
                0307       endif
b6f5c14800 Gael*0308 
69361556c2 Mart*0309       CALL WRITE_0D_L( useCtrlCostContribution, INDEX_NONE,
                0310      &     'useCtrlCostContribution =',
                0311      &     '  /* compute regularisation for gen. ctrls */')
                0312 #ifdef ALLOW_OBCS
                0313       CALL WRITE_0D_L( useObcsCostContribution, INDEX_NONE,
                0314      &     'useObcsCostContribution =',
                0315      &     '  /* compute regularisation for obcs ctrls */')
                0316 C-    these 2 following params are related to currently disabled code:
                0317       IF ( mult_obcsvol .NE. 0. _d 0 ) THEN
                0318        WRITE(msgBuf,'(2A)') '** WARNING ** CTRL_SUMMARY: ',
                0319      &   '"mult_obcsvol" currently has not effect; code needs fixing.'
                0320        CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0321      &                      SQUEEZE_RIGHT, myThid )
                0322       ENDIF
                0323       IF ( mult_ageos.NE.0. _d 0 ) THEN
                0324        WRITE(msgBuf,'(2A)') '** WARNING ** CTRL_SUMMARY: ',
                0325      &   '"mult_ageos" currently has no effect; code needs fixing.'
                0326        CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0327      &                      SQUEEZE_RIGHT, myThid )
                0328       ENDIF
                0329 #endif
                0330 
5cf4364659 Mart*0331       write(msgbuf,'(a)') ' '
4d72283393 Mart*0332       call print_message( msgbuf, standardMessageUnit,
                0333      &                    SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0334       write(msgbuf,'(a)')
                0335      &'// ======================================================='
4d72283393 Mart*0336       call print_message( msgbuf, standardMessageUnit,
                0337      &                    SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0338       write(msgbuf,'(a)')
219393e304 Gael*0339      &'// control vector configuration  >>> END <<<'
4d72283393 Mart*0340       call print_message( msgbuf, standardMessageUnit,
                0341      &                    SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0342       write(msgbuf,'(a)')
                0343      &'// ======================================================='
4d72283393 Mart*0344       call print_message( msgbuf, standardMessageUnit,
                0345      &                    SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0346       write(msgbuf,'(a)') ' '
4d72283393 Mart*0347       call print_message( msgbuf, standardMessageUnit,
                0348      &                    SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0349 
                0350       return
                0351       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!