Back to home page

MITgcm
 
 

    

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

view on githubraw file Latest commit 5cf43646 on 2024-03-01 18:50:49 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
                0037 #endif
7109a141b2 Patr*0038 
                0039 c     == routine arguments ==
4d72283393 Mart*0040       integer myThid
7109a141b2 Patr*0041 
9f5240b52a Jean*0042 c     == external ==
                0043       integer  ilnblnk
                0044       external ilnblnk
7109a141b2 Patr*0045 
9f5240b52a Jean*0046 c     == local variables ==
7109a141b2 Patr*0047       integer bi,bj
9f5240b52a Jean*0048       integer k
5cf4364659 Mart*0049       integer ivar
7109a141b2 Patr*0050       integer il
5cf4364659 Mart*0051       integer errCount
7109a141b2 Patr*0052       integer nwetcenter
                0053       integer nwetsouth
                0054       integer nwetwest
                0055 
                0056       character*(max_len_mbuf) msgbuf
                0057 
cf705a6c8e Mart*0058 #if (defined (ALLOW_GENARR2D_CONTROL) \
                0059       || defined (ALLOW_GENARR3D_CONTROL) \
                0060       || defined (ALLOW_GENTIM2D_CONTROL))
5cf4364659 Mart*0061       INTEGER iarr, jarr, iw
ea1c7c7217 Gael*0062 #endif
cf705a6c8e Mart*0063 #if ( defined ALLOW_GENTIM2D_CONTROL && defined ALLOW_CAL )
9f5240b52a Jean*0064       integer i, timeint(4)
                0065 #endif
7109a141b2 Patr*0066 
                0067 c     == end of interface ==
                0068 
5cf4364659 Mart*0069       errCount = 0
                0070 
                0071       write(msgbuf,'(a)') ' '
4d72283393 Mart*0072       call print_message( msgbuf, standardMessageUnit,
                0073      &                    SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0074       write(msgbuf,'(a)')
                0075      &'// ======================================================='
4d72283393 Mart*0076       call print_message( msgbuf, standardMessageUnit,
                0077      &                    SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0078       write(msgbuf,'(a)')
219393e304 Gael*0079      &'// control vector configuration  >>> START <<<'
4d72283393 Mart*0080       call print_message( msgbuf, standardMessageUnit,
                0081      &                    SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0082       write(msgbuf,'(a)')
                0083      &'// ======================================================='
4d72283393 Mart*0084       call print_message( msgbuf, standardMessageUnit,
                0085      &                    SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0086       write(msgbuf,'(a)') ' '
4d72283393 Mart*0087       call print_message( msgbuf, standardMessageUnit,
                0088      &                    SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0089 
                0090       write(msgbuf,'(a)')
                0091      &' Total number of ocean points per tile:'
4d72283393 Mart*0092       call print_message( msgbuf, standardMessageUnit,
                0093      &                    SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0094       write(msgbuf,'(a)')
                0095      &' --------------------------------------'
4d72283393 Mart*0096       call print_message( msgbuf, standardMessageUnit,
                0097      &                    SQUEEZE_RIGHT, myThid )
                0098       write(msgbuf,'(a,i8)') ' sNx*sNy*Nr = ',sNx*sNy*Nr
                0099       call print_message( msgbuf, standardMessageUnit,
                0100      &                    SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0101       write(msgbuf,'(a)') ' '
4d72283393 Mart*0102       call print_message( msgbuf, standardMessageUnit,
                0103      &                    SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0104       write(msgbuf,'(a)')
                0105      &' Number of ocean points per tile:'
4d72283393 Mart*0106       call print_message( msgbuf, standardMessageUnit,
                0107      &                    SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0108       write(msgbuf,'(a)')
                0109      &' --------------------------------'
4d72283393 Mart*0110       call print_message( msgbuf, standardMessageUnit,
                0111      &                    SQUEEZE_RIGHT, myThid )
                0112       do bj = 1,nSy
                0113         do bi = 1,nSx
7109a141b2 Patr*0114           nwetcenter = 0
                0115           nwetsouth  = 0
                0116           nwetwest   = 0
4d72283393 Mart*0117           do k = 1,Nr
7109a141b2 Patr*0118             nwetcenter = nwetcenter + nwetctile(bi,bj,k)
                0119             nwetsouth  = nwetsouth  + nwetstile(bi,bj,k)
                0120             nwetwest   = nwetwest   + nwetwtile(bi,bj,k)
                0121           enddo
5cf4364659 Mart*0122 c         write(msgbuf,'(a,i5.4,i5.4,i7.6,i7.6,i7.6)')
                0123           write(msgbuf,'(a,i4.3,i4.3,i8,i8,i8)')
                0124      &    ' bi,bj,#(c/s/w):',bi,bj,nwetcenter, nwetsouth, nwetwest
4d72283393 Mart*0125           call print_message( msgbuf, standardMessageUnit,
                0126      &                        SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0127         enddo
                0128       enddo
                0129 
5cf4364659 Mart*0130       do ivar = 1, maxcvars
                0131 C     only print active variables for which ncvarindex has be set
                0132 C     (default = -1)
                0133        if ( ncvarindex(ivar) .GE. 0 ) then
ea1c7c7217 Gael*0134 
5cf4364659 Mart*0135         write(msgbuf,'(a)') ' '
4d72283393 Mart*0136         call print_message( msgbuf, standardMessageUnit,
                0137      &                      SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0138         il   = ILNBLNK( ncvarfname(ivar) )
                0139 C     find out if current variable is a generic control variable name
                0140 #ifdef ALLOW_GENARR3D_CONTROL
                0141         if ( ncvartype(ivar) .eq. 'Arr3D') then
                0142          iarr = ncvarindex(ivar)
                0143          if ( xx_genarr3d_file(iarr) .eq. ncvarfname(ivar) ) then
                0144           write(msgbuf,'(a,i3,a)')
                0145      &    ' -> 3d control, genarr3d no.',iarr,' is in use'
4d72283393 Mart*0146           call print_message( msgbuf, standardMessageUnit,
                0147      &                        SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0148          else
                0149           write(msgbuf,'(a,i6)')
                0150      &    ' -> something is wrong with 3d control, genarr3d no.',iarr
                0151           call print_error( msgbuf, myThid )
                0152           errCount = errCount + 1
6b47d550f4 Mart*0153          endif
5cf4364659 Mart*0154         endif
ea1c7c7217 Gael*0155 #endif
5cf4364659 Mart*0156 #ifdef ALLOW_GENARR2D_CONTROL
                0157         if ( ncvartype(ivar) .eq. 'Arr2D') then
                0158          iarr = ncvarindex(ivar)
                0159          if ( xx_genarr2d_file(iarr) .eq. ncvarfname(ivar) ) then
                0160           write(msgbuf,'(a,i3,a)')
                0161      &    ' -> 2d control, genarr2d no.',iarr,' is in use'
4d72283393 Mart*0162           call print_message( msgbuf, standardMessageUnit,
                0163      &                        SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0164          else
                0165           write(msgbuf,'(a,i6)')
                0166      &    ' -> something is wrong with 2d control, genarr2d no.',iarr
                0167           call print_error( msgbuf, myThid )
                0168           errCount = errCount + 1
6b47d550f4 Mart*0169          endif
5cf4364659 Mart*0170         endif
ea1c7c7217 Gael*0171 #endif
                0172 #ifdef ALLOW_GENTIM2D_CONTROL
5cf4364659 Mart*0173         if ( ncvartype(ivar) .eq. 'Tim2D') then
                0174          iarr = ncvarindex(ivar)
                0175          if ( xx_gentim2d_file(iarr) .eq. ncvarfname(ivar) ) then
                0176           write(msgbuf,'(2a,i3,a)') ' -> ',
                0177      &    'time variable 2d control, gentim2d no.',iarr,' is in use'
                0178           call print_message( msgbuf, standardMessageUnit,
                0179      &                        SQUEEZE_RIGHT, myThid )
                0180          else
                0181           write(msgbuf,'(2a,i6)') ' -> something is wrong with ',
                0182      &    'time variable  2d control, gentim2d no.',iarr
                0183           call print_error( msgbuf, myThid )
                0184           errCount = errCount + 1
                0185          endif
                0186         endif
                0187 #endif
ea1c7c7217 Gael*0188         write(msgbuf,'(a,a)')
5cf4364659 Mart*0189      &'      file       = ',ncvarfname(ivar)(1:il)
4d72283393 Mart*0190         call print_message( msgbuf, standardMessageUnit,
                0191      &                      SQUEEZE_RIGHT, myThid )
ea1c7c7217 Gael*0192         write(msgbuf,'(a,a)')
5cf4364659 Mart*0193      &'      ncvartype  = ', ncvartype(ivar)
4d72283393 Mart*0194         call print_message( msgbuf, standardMessageUnit,
                0195      &                      SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0196         write(msgbuf,'(a,i5,a)')
                0197      &'      index      = ', ivar, '  (use this for pkg/grdchk)'
4d72283393 Mart*0198         call print_message( msgbuf, standardMessageUnit,
                0199      &                      SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0200         write(msgbuf,'(a,i5)')
                0201      &'      ncvarindex = ', ncvarindex(ivar)
4d72283393 Mart*0202         call print_message( msgbuf, standardMessageUnit,
                0203      &                      SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0204 C     extra information only available for generic control variables
                0205 #ifdef ALLOW_GENARR3D_CONTROL
                0206         if ( ncvartype(ivar) .eq. 'Arr3D') then
                0207          iarr = ncvarindex(ivar)
                0208          iw   = ILNBLNK( xx_genarr3d_weight(iarr) )
                0209          write(msgbuf,'(a,a)')
                0210      &'      weight     = ',xx_genarr3d_weight(iarr)(1:iw)
4d72283393 Mart*0211          call print_message( msgbuf, standardMessageUnit,
                0212      &                       SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0213          do jarr=1,maxCtrlProc
                0214           if (xx_genarr3d_preproc(jarr,iarr).NE.' ') then
                0215            il = ilnblnk(xx_genarr3d_preproc(jarr,iarr))
                0216            write(msgbuf,'(a,a)') ' preprocess = ',
                0217      &          xx_genarr3d_preproc(jarr,iarr)(1:il)
4d72283393 Mart*0218            call print_message( msgbuf, standardMessageUnit,
                0219      &                         SQUEEZE_RIGHT, myThid )
513e004a84 Gael*0220           endif
5cf4364659 Mart*0221          enddo
                0222         endif
                0223 #endif
                0224 #ifdef ALLOW_GENARR2D_CONTROL
                0225         if ( ncvartype(ivar) .eq. 'Arr2D' ) then
                0226          iarr = ncvarindex(ivar)
                0227          iw   = ILNBLNK( xx_genarr2d_weight(iarr) )
                0228          write(msgbuf,'(a,a)')
                0229      &'      weight     = ',xx_genarr2d_weight(iarr)(1:iw)
                0230          call print_message( msgbuf, standardMessageUnit,
                0231      &                       SQUEEZE_RIGHT, myThid )
                0232          do jarr=1,maxCtrlProc
                0233           if (xx_genarr2d_preproc(jarr,iarr).NE.' ') then
                0234            il = ilnblnk(xx_genarr2d_preproc(jarr,iarr))
                0235            write(msgbuf,'(a,a)') ' preprocess = ',
                0236      &          xx_genarr2d_preproc(jarr,iarr)(1:il)
4d72283393 Mart*0237            call print_message( msgbuf, standardMessageUnit,
                0238      &                         SQUEEZE_RIGHT, myThid )
4d1f3cfa6a Gael*0239           endif
5cf4364659 Mart*0240          enddo
                0241         endif
                0242 #endif
                0243 #ifdef ALLOW_GENTIM2D_CONTROL
                0244         if ( ncvartype(ivar) .eq. 'Tim2D' ) then
                0245          iarr = ncvarindex(ivar)
                0246          iw   = ILNBLNK( xx_gentim2d_weight(iarr) )
                0247          write(msgbuf,'(a,a)')
                0248      &'      weight     = ',xx_gentim2d_weight(iarr)(1:iw)
                0249          call print_message( msgbuf, standardMessageUnit,
                0250      &                       SQUEEZE_RIGHT, myThid )
                0251 #ifdef ALLOW_CAL
                0252          if ( useCAL ) then
                0253           call cal_TimeInterval( xx_gentim2d_period(iarr),
                0254      &                          'secs', timeint, myThid )
                0255           write(msgbuf,'(a,i9.8,i7.6)')
                0256      &'      period     = ',(timeint(i), i=1,2)
                0257           call print_message( msgbuf, standardMessageUnit,
                0258      &                        SQUEEZE_RIGHT, myThid )
                0259          endif
                0260 #endif
                0261 
                0262          do jarr=1,maxCtrlProc
                0263           if (xx_gentim2d_preproc(jarr,iarr).NE.' ') then
                0264            il = ilnblnk(xx_gentim2d_preproc(jarr,iarr))
                0265            write(msgbuf,'(a,a)') '      preprocess = ',
                0266      &          xx_gentim2d_preproc(jarr,iarr)(1:il)
4d72283393 Mart*0267            call print_message( msgbuf, standardMessageUnit,
                0268      &                         SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0269 C
                0270            if (xx_gentim2d_preproc_c(jarr,iarr).NE.' ') then
                0271             il = ilnblnk(xx_gentim2d_preproc_c(jarr,iarr))
                0272             write(msgbuf,'(a,a)') '        param. (text)= ',
                0273      &           xx_gentim2d_preproc_c(jarr,iarr)(1:il)
                0274             call print_message( msgbuf, standardMessageUnit,
                0275      &                          SQUEEZE_RIGHT, myThid )
                0276            endif
                0277 C
                0278            if (xx_gentim2d_preproc_i(jarr,iarr).NE.0) then
                0279             write(msgbuf,'(a,i6)') '        param. (int.)= ',
                0280      &           xx_gentim2d_preproc_i(jarr,iarr)
                0281             call print_message( msgbuf, standardMessageUnit,
                0282      &                          SQUEEZE_RIGHT, myThid )
                0283            endif
                0284 C
                0285            if (xx_gentim2d_preproc_r(jarr,iarr).NE.0. _d 0) then
                0286             write(msgbuf,'(a,e10.3)') '        param. (real)= ',
                0287      &           xx_gentim2d_preproc_r(jarr,iarr)
                0288             call print_message( msgbuf, standardMessageUnit,
                0289      &                          SQUEEZE_RIGHT, myThid )
                0290            endif
513e004a84 Gael*0291 
5cf4364659 Mart*0292           endif
                0293          enddo
                0294         endif
                0295 #endif
ea1c7c7217 Gael*0296        endif
                0297       enddo
                0298 
5cf4364659 Mart*0299       if ( errCount.GE.1 ) then
                0300         write(msgbuf,'(a,i3,a)')
                0301      &       'ctrl_summary: detected', errCount,' fatal error(s)'
                0302         call print_error( msgbuf, myThid )
                0303         stop 'ABNORMAL END: S/R CTRL_SUMMARY'
                0304       endif
b6f5c14800 Gael*0305 
5cf4364659 Mart*0306       write(msgbuf,'(a)') ' '
4d72283393 Mart*0307       call print_message( msgbuf, standardMessageUnit,
                0308      &                    SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0309       write(msgbuf,'(a)')
                0310      &'// ======================================================='
4d72283393 Mart*0311       call print_message( msgbuf, standardMessageUnit,
                0312      &                    SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0313       write(msgbuf,'(a)')
219393e304 Gael*0314      &'// control vector configuration  >>> END <<<'
4d72283393 Mart*0315       call print_message( msgbuf, standardMessageUnit,
                0316      &                    SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0317       write(msgbuf,'(a)')
                0318      &'// ======================================================='
4d72283393 Mart*0319       call print_message( msgbuf, standardMessageUnit,
                0320      &                    SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0321       write(msgbuf,'(a)') ' '
4d72283393 Mart*0322       call print_message( msgbuf, standardMessageUnit,
                0323      &                    SQUEEZE_RIGHT, myThid )
7109a141b2 Patr*0324 
                0325       return
                0326       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!