Back to home page

MITgcm
 
 

    

File indexing completed on 2025-08-30 05:08:40 UTC

view on githubraw file Latest commit a5926ff8 on 2025-08-30 02:05:51 UTC
97c7a8be8b Jean*0001 #include "STREAMICE_OPTIONS.h"
                0002 
                0003 CBOP
                0004 C !ROUTINE: STREAMICE_WRITE_PICKUP
                0005 
                0006 C !INTERFACE: ==========================================================
                0007       SUBROUTINE STREAMICE_WRITE_PICKUP( permPickup,
                0008      &                    suff, myTime, myIter, myThid )
                0009 
                0010 C !DESCRIPTION:
a5926ff804 dngo*0011 C     Writes current state of pkg/streamice to a pickup file
97c7a8be8b Jean*0012 
                0013 C !USES: ===============================================================
                0014       IMPLICIT NONE
                0015 #include "SIZE.h"
                0016 #include "EEPARAMS.h"
                0017 #include "PARAMS.h"
                0018 #include "STREAMICE.h"
                0019 
                0020 C !INPUT PARAMETERS: ===================================================
                0021 C     permPickup      :: write a permanent pickup
                0022 C     suff            :: suffix for pickup file (eg. ckptA or 0000000010)
                0023 C     myTime          :: model time
                0024 C     myIter          :: time-step number
                0025 C     myThid          :: thread number
                0026       LOGICAL permPickup
                0027       CHARACTER*(*) suff
                0028       _RL myTime
                0029       INTEGER myIter
                0030       INTEGER myThid
                0031 
                0032 C !OUTPUT PARAMETERS: ==================================================
                0033 C  none
                0034 
                0035 #ifdef ALLOW_STREAMICE
                0036 C     === Functions ====
                0037       INTEGER  ILNBLNK
                0038       EXTERNAL ILNBLNK
                0039 
                0040 C !LOCAL VARIABLES: ====================================================
                0041 C     j           :: loop index / field number
                0042 C     nj          :: record number
                0043 C     fp          :: pickup-file precision
                0044 C     glf         :: local flag for "globalFiles"
                0045 C     fn          :: character buffer for creating filename
                0046 C     nWrFlds     :: number of fields being written
                0047 C     listDim     :: dimension of "wrFldList" local array
                0048 C     wrFldList   :: list of written fields
                0049 C     msgBuf      :: Informational/error message buffer
                0050       INTEGER j, nj, fp, lChar
                0051       LOGICAL glf
                0052       _RL     timList(1)
                0053       CHARACTER*(MAX_LEN_FNAM) fn
                0054       INTEGER listDim, nWrFlds
                0055       PARAMETER( listDim = 12 )
                0056       CHARACTER*(8) wrFldList(listDim)
                0057       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0058 CEOP
                0059 
                0060         lChar = ILNBLNK(suff)
                0061         IF ( lChar.EQ.0 ) THEN
                0062           WRITE(fn,'(2A)') 'pickup_streamice'
                0063         ELSE
                0064           WRITE(fn,'(2A)') 'pickup_streamice.',suff(1:lChar)
                0065         ENDIF
                0066         fp = precFloat64
                0067         j  = 0
                0068 
                0069 C       Firstly, write 3-D fields as consecutive records,
                0070 
                0071 #ifdef STREAMICE_HYBRID_STRESS
                0072 C     record number < 0 : a hack not to write meta files now:
                0073         j = j + 1
a5926ff804 dngo*0074 #ifdef ALLOW_OPENAD
                0075         CALL WRITE_REC_3D_RL( fn, fp, Nr, visc_streamice_full%v,
                0076      &                        -j, myIter, myThid )
                0077 #else
7360cc2681 Jean*0078         CALL WRITE_REC_3D_RL( fn, fp, Nr, visc_streamice_full,
                0079      &                        -j, myIter, myThid )
a5926ff804 dngo*0080 #endif
97c7a8be8b Jean*0081         IF (j.LE.listDim) wrFldList(j) = 'visc3d  '
                0082 #endif /* STREAMICE_HYBRID_STRESS */
                0083 
                0084 C-    switch to 2-D fields:
                0085         nj = -j*Nr
                0086 
                0087         j = j + 1
                0088         nj = nj-1
a5926ff804 dngo*0089 #ifdef ALLOW_OPENAD
                0090         CALL WRITE_REC_3D_RL( fn, fp, 1, area_shelf_streamice%v,
                0091      &                        nj, myIter, myThid )
                0092 #else
7360cc2681 Jean*0093         CALL WRITE_REC_3D_RL( fn, fp, 1, area_shelf_streamice,
                0094      &                        nj, myIter, myThid )
a5926ff804 dngo*0095 #endif
97c7a8be8b Jean*0096         IF (j.LE.listDim) wrFldList(j) = 'SI_area '
                0097 
eaf63fbcc2 Dani*0098         j = j + 1
                0099         nj = nj-1
7360cc2681 Jean*0100         CALL WRITE_REC_3D_RS( fn, fp, 1, STREAMICE_hmask,
                0101      &                        nj, myIter, myThid )
eaf63fbcc2 Dani*0102         IF (j.LE.listDim) wrFldList(j) = 'SI_hmask'
                0103 
                0104         j = j + 1
                0105         nj = nj-1
a5926ff804 dngo*0106 #ifdef ALLOW_OPENAD
                0107         CALL WRITE_REC_3D_RL( fn, fp, 1, U_streamice%v,
                0108      &                        nj, myIter, myThid )
                0109 #else
7360cc2681 Jean*0110         CALL WRITE_REC_3D_RL( fn, fp, 1, U_streamice,
                0111      &                        nj, myIter, myThid )
a5926ff804 dngo*0112 #endif
eaf63fbcc2 Dani*0113         IF (j.LE.listDim) wrFldList(j) = 'SI_uvel '
                0114 
                0115         j = j + 1
                0116         nj = nj-1
a5926ff804 dngo*0117 #ifdef ALLOW_OPENAD
                0118         CALL WRITE_REC_3D_RL( fn, fp, 1, V_streamice%v,
                0119      &                        nj, myIter, myThid )
                0120 #else
7360cc2681 Jean*0121         CALL WRITE_REC_3D_RL( fn, fp, 1, V_streamice,
                0122      &                        nj, myIter, myThid )
a5926ff804 dngo*0123 #endif
eaf63fbcc2 Dani*0124         IF (j.LE.listDim) wrFldList(j) = 'SI_vvel '
                0125 
                0126         j = j + 1
                0127         nj = nj-1
a5926ff804 dngo*0128 #ifdef ALLOW_OPENAD
                0129         CALL WRITE_REC_3D_RL( fn, fp, 1, H_streamice%v,
                0130      &                        nj, myIter, myThid )
                0131 #else
7360cc2681 Jean*0132         CALL WRITE_REC_3D_RL( fn, fp, 1, H_streamice,
                0133      &                        nj, myIter, myThid )
a5926ff804 dngo*0134 #endif
eaf63fbcc2 Dani*0135         IF (j.LE.listDim) wrFldList(j) = 'SI_thick'
7360cc2681 Jean*0136 
eaf63fbcc2 Dani*0137         j = j + 1
                0138         nj = nj-1
a5926ff804 dngo*0139 #ifdef ALLOW_OPENAD
                0140         CALL WRITE_REC_3D_RL( fn, fp, 1, tau_beta_eff_streamice%v,
                0141      &                        nj, myIter, myThid )
                0142 #else
7360cc2681 Jean*0143         CALL WRITE_REC_3D_RL( fn, fp, 1, tau_beta_eff_streamice,
                0144      &                        nj, myIter, myThid )
a5926ff804 dngo*0145 #endif
eaf63fbcc2 Dani*0146         IF (j.LE.listDim) wrFldList(j) = 'SI_betaF'
                0147 
                0148         j = j + 1
                0149         nj = nj-1
a5926ff804 dngo*0150 #ifdef ALLOW_OPENAD
                0151         CALL WRITE_REC_3D_RL( fn, fp, 1, visc_streamice%v,
                0152      &                        nj, myIter, myThid )
                0153 #else
7360cc2681 Jean*0154         CALL WRITE_REC_3D_RL( fn, fp, 1, visc_streamice,
                0155      &                        nj, myIter, myThid )
a5926ff804 dngo*0156 #endif
eaf63fbcc2 Dani*0157         IF (j.LE.listDim) wrFldList(j) = 'SI_visc '
                0158 
                0159 #ifdef STREAMICE_HYBRID_STRESS
                0160         j = j + 1
                0161         nj = nj-1
a5926ff804 dngo*0162 #ifdef ALLOW_OPENAD
                0163         CALL WRITE_REC_3D_RL( fn, fp, 1, streamice_taubx%v,
                0164      &                        nj, myIter, myThid )
                0165 #else
7360cc2681 Jean*0166         CALL WRITE_REC_3D_RL( fn, fp, 1, streamice_taubx,
                0167      &                        nj, myIter, myThid )
a5926ff804 dngo*0168 #endif
eaf63fbcc2 Dani*0169         IF (j.LE.listDim) wrFldList(j) = 'SI_taubx'
                0170 
                0171         j = j + 1
                0172         nj = nj-1
a5926ff804 dngo*0173 #ifdef ALLOW_OPENAD
                0174         CALL WRITE_REC_3D_RL( fn, fp, 1, streamice_tauby%v,
                0175      &                        nj, myIter, myThid )
                0176 #else
7360cc2681 Jean*0177         CALL WRITE_REC_3D_RL( fn, fp, 1, streamice_tauby,
                0178      &                        nj, myIter, myThid )
a5926ff804 dngo*0179 #endif
eaf63fbcc2 Dani*0180         IF (j.LE.listDim) wrFldList(j) = 'SI_tauby'
                0181 #endif
                0182 
97c7a8be8b Jean*0183 c       j = j + 1
                0184 c       nj = nj-1
7360cc2681 Jean*0185 c       CALL WRITE_REC_3D_RL( fn, fp, 1, myPa_Surf2,
                0186 c    &                        nj, myIter, myThid )
97c7a8be8b Jean*0187 c       IF (j.LE.listDim) wrFldList(j) = 'myPaSur2'
                0188 
                0189 C--------------------------
                0190         nWrFlds = j
                0191         IF ( nWrFlds.GT.listDim ) THEN
                0192           WRITE(msgBuf,'(2A,I5,A)') 'STREAMICE_WRITE_PICKUP: ',
                0193      &     'trying to write ',nWrFlds,' fields'
                0194           CALL PRINT_ERROR( msgBuf, myThid )
                0195           WRITE(msgBuf,'(2A,I5,A)') 'STREAMICE_WRITE_PICKUP: ',
                0196      &     'field-list dimension (listDim=',listDim,') too small'
                0197           CALL PRINT_ERROR( msgBuf, myThid )
                0198           CALL ALL_PROC_DIE( myThid )
                0199           STOP 'ABNORMAL END: S/R STREAMICE_WRITE_PICKUP (list-size Pb)'
                0200         ENDIF
                0201 #ifdef ALLOW_MDSIO
                0202 C     uses this specific S/R to write (with more informations) only meta files
                0203         j  = 1
                0204         nj = ABS(nj)
                0205         IF ( nWrFlds*Nr .EQ. nj ) THEN
                0206           j  = Nr
                0207           nj = nWrFlds
                0208         ENDIF
                0209         glf  = globalFiles
                0210         timList(1) = myTime
                0211         CALL MDS_WR_METAFILES( fn, fp, glf, .FALSE.,
                0212      &                         0, 0, j, ' ',
                0213      &                         nWrFlds, wrFldList,
                0214      &                         1, timList, oneRL,
                0215      &                         nj, myIter, myThid )
                0216 #endif /* ALLOW_MDSIO */
                0217 C--------------------------
                0218 
                0219 #endif /* ALLOW_STREAMICE */
                0220 
                0221       RETURN
                0222       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!