C $Header: /u/gcmpack/MITgcm/pkg/bling/bling_write_pickup.F,v 1.3 2016/09/12 20:00:28 mmazloff Exp $ C $Name: $ #include "BLING_OPTIONS.h" CBOP subroutine BLING_WRITE_PICKUP( permPickup, I suff, myTime, myIter, myThid ) C ================================================================= C | subroutine bling_write_pickup C | o Writes BLING arrays (needed for a restart) to a pickup file C ================================================================= implicit none C === Global variables === #include "SIZE.h" #include "EEPARAMS.h" #include "PARAMS.h" #include "BLING_VARS.h" C === Routine arguments === C permPickup :: write a permanent pickup C suff :: suffix for pickup file (eg. ckptA or 0000000010) C myTime :: Current time in simulation C myIter :: Current iteration number in simulation C myThid :: My Thread Id number LOGICAL permPickup CHARACTER*(*) suff _RL myTime INTEGER myIter INTEGER myThid CEOP #ifdef ALLOW_BLING C == Local variables == CHARACTER*(MAX_LEN_FNAM) fn INTEGER prec #ifndef USE_ATMOSCO2 INTEGER ioUnit _RL tmpFld(2) _RS dummyRS(1) #endif LOGICAL glf _RL timList(1) INTEGER j, nj INTEGER listDim, nWrFlds PARAMETER( listDim = 6 ) CHARACTER*(8) wrFldList(listDim) CHARACTER*(MAX_LEN_MBUF) msgBuf prec = precFloat64 WRITE(fn,'(A,A)') 'pickup_bling.',suff j = 0 C Firstly, write 3-D fields as consecutive records, C record number < 0 : a hack not to write meta files now: j = j + 1 CALL WRITE_REC_3D_RL( fn, prec, Nr, pH, -j, myIter, myThid ) IF (j.LE.listDim) wrFldList(j) = 'BLG_pH3d' j = j + 1 CALL WRITE_REC_3D_RL( fn, prec, Nr, irr_mem, & -j, myIter, myThid ) IF (j.LE.listDim) wrFldList(j) = 'BLG_irrm' j = j + 1 CALL WRITE_REC_3D_RL( fn, prec, Nr, chl, -j, myIter, myThid ) IF (j.LE.listDim) wrFldList(j) = 'BLG_chl ' j = j + 1 CALL WRITE_REC_3D_RL( fn, prec, Nr, phyto_sm, -j, myIter, & myThid ) IF (j.LE.listDim) wrFldList(j) = 'BLG_Psm ' j = j + 1 CALL WRITE_REC_3D_RL( fn, prec, Nr, phyto_lg, -j, myIter, & myThid ) IF (j.LE.listDim) wrFldList(j) = 'BLG_Plg ' j = j + 1 CALL WRITE_REC_3D_RL( fn, prec, Nr, phyto_diaz, -j, myIter, & myThid ) IF (j.LE.listDim) wrFldList(j) = 'BLG_Pdia' C-------------------------- nWrFlds = j IF ( nWrFlds.GT.listDim ) THEN WRITE(msgBuf,'(2A,I5,A)') 'BLING_WRITE_PICKUP: ', & 'trying to write ',nWrFlds,' fields' CALL PRINT_ERROR( msgBuf, myThid ) WRITE(msgBuf,'(2A,I5,A)') 'BLING_WRITE_PICKUP: ', & 'field-list dimension (listDim=',listDim,') too small' CALL PRINT_ERROR( msgBuf, myThid ) STOP 'ABNORMAL END: S/R BLING_WRITE_PICKUP (list-size Pb)' ENDIF #ifdef ALLOW_MDSIO C uses this specific S/R to write (with more informations) only meta C files j = 1 glf = globalFiles timList(1) = myTime CALL MDS_WR_METAFILES( fn, prec, glf, .FALSE., & 0, 0, Nr, ' ', & nWrFlds, wrFldList, & 1, timList, oneRL, & j, myIter, myThid ) #endif /* ALLOW_MDSIO */ C-------------------------- #endif /* ALLOW_BLING */ RETURN END