! $Header: /home/ubuntu/mnt/e9_copy/MITgcm_contrib/quarter_degree_global/code_srdiags/srdiags_manager.F,v 1.1.1.1 2006/07/28 22:00:12 cnh Exp $ ! $Name: $ MODULE SRDIAGS_MANAGER ! ! SR_DIAGS provides sub-region diagnostic accumulation for logically ! rectangular meshes. ! In MITgcm it is called from within DIAGS. ! SR_DIAGS allocates buffers for saving sub-region data for particular fields ! These buffers need to be allocated by the threads that will write to ! them. Buffers are visible for read access across threads to allow for sinlge ! threade I/O and communication - yucky..... ! USE SRDIAGS_TYPES INTERFACE SRDIAG_FILL MODULE PROCEDURE SRDIAG_FILL_R8XYZ END INTERFACE CONTAINS SUBROUTINE SRDIAG_ADD_FCODE( fCode, offset, dAttr, diagVar, I mFactor, & myThid ) ! ! Add a field code to a SRDIAGS set ! Indices for this field code will use offset "offset". ! ! == Routine arguments == CHARACTER*(*) fCode INTEGER offset(3) CHARACTER*(*) dAttr TYPE(SRDIAG_SPEC), POINTER :: diagVar INTEGER myThid, nCodes REAL*8 mFactor ! == Local variables == TYPE(SRDIAG_FCODE), POINTER :: tempCL(:) ! ! Expand list ! diagVar%nCodes = diagVar%nCodes+1 nCodes = diagVar%nCodes IF ( nCodes .EQ. 1 ) THEN ALLOCATE( diagVar%cList(1) ) ELSE ALLOCATE( tempCL(nCodes-1) ) tempCL = diagVar%cList DEALLOCATE( diagVar%cList ) ALLOCATE( diagVar%cList(nCodes) ) diagVar%cList(1:nCodes-1) = tempCL DEALLOCATE( tempCL ) ENDIF ! ! Add entry ! diagVar%cList(nCodes)%fCode = fCode diagVar%cList(nCodes)%dAttr = dAttr diagVar%cList(nCodes)%iOffset = offset(1) diagVar%cList(nCodes)%jOffset = offset(2) diagVar%cList(nCodes)%kOffset = offset(3) diagVar%cList(nCodes)%mFactor = mFactor RETURN END SUBROUTINE SUBROUTINE SRDIAG_ADD_REGION( I myLoI, myLoJ, myLoK, I myNI, myNJ, myNK, I iLo, jLo, kLo, I nI, nJ, nK, U diagVar, I myThid ) ! ! Add a simple region to a DIAG type variable ! ! Lots still to be done..... ! DIAGS specification file must have been read before SR_DIAG_CREATE is called. ! ! Here we create masks for each of the index sets specified in the sub-region set. ! These masks can be do loop regions, scatters, broken lines etc... ! o do loop regions are specified in the input using [start:stride:end] or [v1 v2 v3] sets ! of values. ! o not sure how we specify scatters and broken lines in input yet. probably using ! { } for point lists instead of [ ] for loops. ! Note - { } point lists for a single region specification have to all be the same size. ! - e.g. ! {1 3 5}{7 4 8}[1 2] would give ! for k=1:2 ! for lp=1:3 ! pt=[il(1), jl(1), k] ! end ! end ! - whereas ! [1 3 5][7 4 8][1 2] would give ! for k=1:2 ! for j=[7 4 8] ! for i=[1 3 5] ! pt=[i, j, k] ! end ! end ! end ! ! -- Routine arguments -- ! myLoI :: Offset from origin for this part of the mask. ! myLoJ :: Offset from origin for this part of the mask. ! myLoK :: Offset from origin for this part of the mask. ! myNi :: Number cells in I for this part of the mask. ! myNj :: Number cells in J for this part of the mask. ! myNk :: Number cells in K for this part of the mask. ! iLo :: Base coordinate in I for subregion. ! jLo :: Base coordinate in J for subregion. ! kLo :: Base coordinate in K for subregion. ! nI :: Number of cells in I for subregion. ! nJ :: Number of cells in J for subregion. ! nK :: Number of cells in K for subregion. ! diagVar :: Diagnostics structure to add region to. ! myThid :: Id number of the thread making this call. INTEGER myLoI INTEGER myLoJ INTEGER myLoK INTEGER myNi INTEGER myNj INTEGER myNk INTEGER iLo INTEGER jLo INTEGER kLo INTEGER nI INTEGER nJ INTEGER nK TYPE(SRDIAG_SPEC), POINTER :: diagVar INTEGER myThid ! -- Local variables -- ! TYPE(SRDIAG_MASK), POINTER :: tempML(:) INTEGER :: I, J, K INTEGER :: nPS ! ! Expand list diagVar%nPointSets = diagVar%nPointSets+1 nPS = diagVar%nPointSets IF ( nPS .EQ. 1 ) THEN ALLOCATE( diagVar%mList(1) ) ELSE ALLOCATE( tempML(nPS-1) ) tempML = diagVar%mList DEALLOCATE(diagVar%mList) ALLOCATE( diagVar%mList(nPS) ) diagVar%mList(1:nPS-1)=tempML DEALLOCATE(tempML) ENDIF ! ! Now add new diag ! o create mask for this instance ! for now this mask has size of the region owned ! by the instance. ALLOCATE( & diagVar%mList(nPS)%mask( & myLoI:myLoI+myNI-1, & myLoJ:myLoJ+myNJ-1, & myLoK:myLoK+myNK-1 & ) &) diagVar%mList(nPS)%mask = .FALSE. DO K=myLoK,myLoK+myNK-1 IF ( K .GE. kLo .AND. K .LE. kLo+nK-1 ) THEN DO J=myLoJ,myLoJ+myNJ-1 IF ( J .GE. jLo .AND. J .LE. jLo+nJ-1 ) THEN DO I=myLoI,myLoI+myNI-1 IF ( I .GE. iLo .AND. I .LE. iLo+nI-1 ) THEN diagVar%mList(nPS)%mask(I,J,K) = .TRUE. ! PRINT *, ' HELLO -1', myThid,I,J,K ENDIF ENDDO ENDIF ENDDO ENDIF ENDDO diagVar%mList(nPS)%nX = nI diagVar%mList(nPS)%nY = nJ diagVar%mList(nPS)%nR = nK diagVar%mList(nPS)%iLo = iLo diagVar%mList(nPS)%jLo = jLo diagVar%mList(nPS)%kLo = kLo RETURN END SUBROUTINE SUBROUTINE SRDIAG_CREATE( diagVar, aveFreq, outName, myThid ) ! ! Create a sub-region diagnostics spec object ! ! == Routine arguments == TYPE(SRDIAG_SPEC), POINTER :: diagVar REAL*8 :: aveFreq CHARACTER*(*) :: outName INTEGER myThid ! == Local variables == INTEGER iUnit ALLOCATE( diagVar ) diagVar%nPointSets = 0 diagVar%nCodes = 0 diagVar%aPeriod = aveFreq WRITE( diagVar%outName, '(A,A,I4.4)' ) TRIM(outName),'.',myThid NULLIFY(diagVar%bList) NULLIFY(diagVar%cList) ! Clear the output file CALL MDSFINDUNIT( iUnit, myThid ) OPEN(unit=iUnit,file=TRIM(diagVar%outName), & FORM='unformatted',STATUS='NEW') CLOSE(iUnit) RETURN END SUBROUTINE SUBROUTINE SRDIAG_FILL_R8XYZ( fld, alpha, fCode, diagVar, myThid ) ! == Routine arguments == REAL*8 :: fld(:,:,:) REAL*8 :: alpha CHARACTER*(*) :: fCode TYPE(SRDIAG_SPEC), POINTER :: diagVar INTEGER :: myThid ! == Local variables == INTEGER :: nRegs, nBufs INTEGER :: I, J, K, rC, thisCodeRank, NR INTEGER :: iB TYPE(SRDIAG_BUFFER), POINTER :: myBufs(:) TYPE(SRDIAG_BUFFER), POINTER :: myBuf INTEGER :: iLoFld, jLoFld, kLoFld INTEGER :: iHiFld, jHiFld, kHiFld INTEGER :: iLo, iHi, jLo, jHi, kLo, kHi INTEGER :: iLoMsk, iHiMsk INTEGER :: jLoMsk, jHiMsk INTEGER :: kLoMsk, kHiMsk INTEGER :: iFld, jFld, kFld ! ! PRINT *, 'HELLO 1' ! Determine the field code rank for the field code fCode within subregion diagVar. CALL SRDIAG_GET_FIELD_CODE_RANK( I fCode, diagVar, O thisCodeRank, I myThid ) IF ( thisCodeRank .EQ. 0 ) RETURN ! PRINT *, 'HELLO 2' ! Look for an existing buffer for this code (for each region in turn ! so that we find out if there are regions with no buffers). ! If buffer is found we will use that buffer, otherwise we will create it. nRegs = diagVar%nPointSets iLoFld = LBOUND(fld,1)+diagVar%cList(thisCodeRank)%iOffset jLoFld = LBOUND(fld,2)+diagVar%cList(thisCodeRank)%jOffset kLoFld = LBOUND(fld,3)+diagVar%cList(thisCodeRank)%kOffset iHiFld = UBOUND(fld,1)+diagVar%cList(thisCodeRank)%iOffset jHiFld = UBOUND(fld,2)+diagVar%cList(thisCodeRank)%jOffset kHiFld = UBOUND(fld,3)+diagVar%cList(thisCodeRank)%kOffset ! PRINT *, 'HELLO 3', iLoFld, iHiFld, TRIM(fCode) ! PRINT *, 'HELLO 3', jLoFld, jHiFld, TRIM(fCode) ! PRINT *, 'HELLO 3', kLoFld, kHiFld, TRIM(fCode) DO NR=1,nRegs ! Find the buffer for region I and field code with rank thisCodeRank NULLIFY(myBuf) CALL SRDIAG_GET_DATA_BUFFER( thisCodeRank, NR, diagVar, I iLoFld, jLoFld, kLoFld, I iHiFld, jHiFld, kHiFld, O myBuf, I myThid ) ! Now do masked add of data to the subregion buffer pointed to by myBuf ! PRINT *, 'HELLO 4 REGION', NR, TRIM(fCode) iB = 0 iLoMsk = LBOUND(diagVar%mList(NR)%mask,1) iLo = MAX(iLoFld, iLoMsk ) iHiMsk = UBOUND(diagVar%mList(NR)%mask,1) iHi = MIN(iHiFld, iHiMsk ) jLoMsk = LBOUND(diagVar%mList(NR)%mask,2) jLo = MAX(jLoFld, jLoMsk ) jHiMsk = UBOUND(diagVar%mList(NR)%mask,2) jHi = MIN(jHiFld, jHiMsk ) kLoMsk = LBOUND(diagVar%mList(NR)%mask,3) kLo = MAX(kLoFld, kLoMsk ) kHiMsk = UBOUND(diagVar%mList(NR)%mask,3) kHi = MIN(kHiFld, kHiMsk ) ! PRINT *, 'HELLO 4 kLo, kHi', kLo, kHi ! PRINT *, 'HELLO 4 jLo, jHi', jLo, jHi ! PRINT *, 'HELLO 4 iLo, iHi', iLo, iHi DO K=kLo,kHi DO J=jLo,jHi DO I=iLo,iHi IF ( diagVar%mList(NR)%mask(I,J,K) .EQV. .TRUE. ) & THEN iFld=I-diagVar%cList(thisCodeRank)%iOffset jFld=J-diagVar%cList(thisCodeRank)%jOffset kFld=K-diagVar%cList(thisCodeRank)%kOffset iB =iB+1 ! PRINT *, ' HELLO 7 ADDING TO BUFFER', myThid,iFld,jFld,kFld myBuf%r8Values(iB) = myBuf%r8Values(iB)+ & fld(iFld,jFld,kFld) & *alpha*diagVar%cList(thisCodeRank)%mFactor ! PRINT *, ' HELLO 7 ADDED TO BUFFER', myThid,iFld,jFld,kFld ENDIF ENDDO ENDDO ENDDO ENDDO ! PRINT *, 'HELLO 4 LEAVING FIELD ADD' RETURN END SUBROUTINE SUBROUTINE SRDIAG_GET_DATA_BUFFER( thisCodeRank, thisRegionRank, I diagVar, I iLoFld, I jLoFld, I kLoFld, I iHiFld, I jHiFld, I kHiFld, O theBuf, I myThid ) ! Search through sub-region specification diagVar for data buffer ! associated with the region with region rank "thisRegionRank" and the field code with ! field code rank "thisCodeRank". ! Return pointer to the buffer, creating the buffer if need be. ! == Routine arguments == INTEGER :: thisCodeRank INTEGER :: thisRegionRank TYPE(SRDIAG_SPEC), POINTER :: diagVar INTEGER :: iLoFld INTEGER :: jLoFld INTEGER :: kLoFld INTEGER :: iHiFld INTEGER :: jHiFld INTEGER :: kHiFld TYPE(SRDIAG_BUFFER), POINTER :: theBuf INTEGER :: myThid ! == Local variables == INTEGER :: nRegs, nBufs, I, J, K, nCells INTEGER :: iLo, iHi, iLoMsk, iHiMsk INTEGER :: jLo, jHi, jLoMsk, jHiMsk INTEGER :: kLo, kHi, kLoMsk, kHiMsk TYPE(SRDIAG_BUFFER), POINTER :: dBufs(:) TYPE(SRDIAG_BUFFER), POINTER :: tempBList(:) ! PRINT *, 'HELLO 4 GET_DATA_BUFFER', thisCodeRank, thisRegionRank ! CALL SRDIAG_GET_DATA_BUFFER_NOCREATE( I thisCodeRank, thisRegionRank, diagVar, O theBuf, I myThid ) ! ! If we didn't find a buffer we need to create it IF ( .NOT. ASSOCIATED(theBuf) ) THEN ! First need to figure out how big the buffer needs to be ! We have two sets of indices ! fld (iLoFld:iHiFld,jLoFld:jHiFld,kLoFld:kHiFld) and ! mask(iLo:iLo+nX-1,jLo:jLo+nY-1,kLo:kLo+nR-1) ! the number of cells we will have in buffer is the number of ! mask values that are true in the fld index range. However, ! we _must_not_ simpy reference mask with fld index ranges ! because they may lie outside the valid index range for mask. nCells = 0 iLoMsk = LBOUND(diagVar%mList(thisRegionRank)%mask,1) iLo = MAX(iLoFld, iLoMsk ) iHiMsk = UBOUND(diagVar%mList(thisRegionRank)%mask,1) iHi = MIN(iHiFld, iHiMsk ) jLoMsk = LBOUND(diagVar%mList(thisRegionRank)%mask,2) jLo = MAX(jLoFld, jLoMsk ) jHiMsk = UBOUND(diagVar%mList(thisRegionRank)%mask,2) jHi = MIN(jHiFld, jHiMsk ) kLoMsk = LBOUND(diagVar%mList(thisRegionRank)%mask,3) kLo = MAX(kLoFld, kLoMsk ) kHiMsk = UBOUND(diagVar%mList(thisRegionRank)%mask,3) kHi = MIN(kHiFld, kHiMsk ) DO K=kLo,kHi DO J=jLo,jHi DO I=iLo,iHi IF ( diagVar%mList(thisRegionRank)%mask(I,J,K) .EQV. .TRUE. ) & THEN nCells = nCells+1 ENDIF ENDDO ENDDO ENDDO ! PRINT *, 'HELLO 4 iLo, iHi = ', iLo, iHi ! PRINT *, 'HELLO 4 jLo, jHi = ', jLo, jHi ! PRINT *, 'HELLO 4 kLo, kHi = ', kLo, kHi ! PRINT *, 'HELLO 4 nCells = ', nCells, thisRegionRank,thisCodeRank ! Add a new entry at the end of the sub-region buffer list IF ( ASSOCIATED(diagVar%bList) ) THEN ! List is not empty so we need to increase its size nBufs = UBOUND(diagVar%bList,1) ALLOCATE(tempBList(nBufs)) tempBList = diagVar%bList DEALLOCATE(diagVar%bList) ALLOCATE(diagVar%bList(nBufs+1)) diagVar%bList(1:nBufs) = tempBList ALLOCATE(theBuf) diagVar%bList(nBufs+1) = theBuf ELSE ! List is empty so we create for first time ALLOCATE(diagVar%bList(1)) ALLOCATE(theBuf) diagVar%bList(1) = theBuf ENDIF ! Now fill out the new buffer (which is at the end of the list) nBufs = UBOUND(diagVar%bList,1) ! Add ranks and initial flags diagVar%bList(nBufs)%metaWritten = .FALSE. diagVar%bList(nBufs)%vType = SRDIAG_R8TYPE diagVar%bList(nBufs)%fCodeRank = thisCodeRank diagVar%bList(nBufs)%regionRank = thisRegionRank ! Add data buffer to the entry at the end NULLIFY(diagVar%bList(nBufs)%r8Values) NULLIFY(diagVar%bList(nBufs)%r4Values) NULLIFY(diagVar%bList(nBufs)%iValues) IF ( nCells .GT. 0 ) THEN ALLOCATE(diagVar%bList(nBufs)%r8Values(nCells) ) ! For a newly allocated buffer we set the initial value to zero diagVar%bList(nBufs)%r8Values = 0. ENDIF theBuf => diagVar%bList(nBufs) ENDIF RETURN END SUBROUTINE SUBROUTINE SRDIAG_GET_DATA_BUFFER_NOCREATE( thisCodeRank, I thisRegionRank, I diagVar, O theBuf, I myThid ) ! Search through sub-region specification diagVar for data buffer ! associated with the region with region rank "thisRegionRank" and the field code with ! field code rank "thisCodeRank". ! Return pointer to the buffer. ! == Routine arguments == INTEGER :: thisCodeRank INTEGER :: thisRegionRank TYPE(SRDIAG_SPEC), POINTER :: diagVar TYPE(SRDIAG_BUFFER), POINTER :: theBuf INTEGER :: myThid ! == Local variables == INTEGER :: nRegs, nBufs, I, J TYPE(SRDIAG_BUFFER), POINTER :: dBufs(:) ! NULLIFY(theBuf) nRegs = diagVar%nPointSets IF ( ASSOCIATED(diagVar%bList) ) THEN DO J=1,nRegs dBufs => diagVar%bList nBufs = UBOUND( dBufs,1 ) ! Work through the buffers DO I=1,nBufs ! Select buffers associated with this codes rank IF ( diagVar%bList(I)%fCodeRank .EQ. thisCodeRank .AND. & diagVar%bList(I)%regionRank .EQ. thisRegionRank ) THEN ! PRINT *, 'FOUND BUFFER FOR rank, code', thisCodeRank, ! & thisRegionRank theBuf => diagVar%bList(I) ENDIF ENDDO ENDDO ENDIF ! RETURN END SUBROUTINE SUBROUTINE SRDIAG_GET_FIELD_CODE_RANK( I fCode, diagVar, O thisCodeRank, I myThid ) ! == Routine arguments == CHARACTER*(*) :: fCode TYPE(SRDIAG_SPEC), POINTER :: diagVar INTEGER :: thisCodeRank INTEGER :: myThid ! == Local variables == INTEGER :: I thisCodeRank = 0 IF ( ASSOCIATED(diagVar%cList) ) THEN DO I=1,UBOUND(diagVar%cList,1) IF ( diagVar%cList(I)%fCode .EQ. fCode ) THEN thisCodeRank = I ENDIF ENDDO ENDIF RETURN END SUBROUTINE SUBROUTINE SRDIAG_INIT( myThid ) ! ! Initialize the SR_DIAGS package ! Doesn't do anything! ! ! myThid :: Thread rank INTEGER myThid RETURN END SUBROUTINE SUBROUTINE SRDIAG_SCALE( alpha, fCode, diagVar, myThid ) ! == Routine arguments == REAL*8 :: alpha CHARACTER*(*) :: fCode TYPE(SRDIAG_SPEC), POINTER :: diagVar INTEGER :: myThid ! == Local variables == INTEGER :: nRegs, nBufs INTEGER :: I, J, rC, thisCodeRank, NR INTEGER :: iB TYPE(SRDIAG_BUFFER), POINTER :: myBufs(:) TYPE(SRDIAG_BUFFER), POINTER :: myBuf INTEGER :: iLoFld, jLoFld, kLoFld INTEGER :: iHiFld, jHiFld, kHiFld INTEGER :: iLo, iHi, jLo, jHi, kLo, kHi ! Determine the field code rank for the field code fCode within subregion diagVar. CALL SRDIAG_GET_FIELD_CODE_RANK( I fCode, diagVar, O thisCodeRank, I myThid ) IF ( thisCodeRank .EQ. 0 ) RETURN ! PRINT *, ' HELLO 5 thisCodeRank = ', thisCodeRank, myThid ! Look for existing buffers for this code for each region. nRegs = diagVar%nPointSets DO NR=1,nRegs ! Find the buffer for region NR and field code with rank thisCodeRank CALL SRDIAG_GET_DATA_BUFFER_NOCREATE( thisCodeRank, NR, diagVar, O myBuf, I myThid ) ! Now scale the buffer values IF ( ASSOCIATED(myBuf) ) THEN IF ( ASSOCIATED(myBuf%r8Values) ) THEN ! PRINT *, ' HELLO 6 ASSOCIATED ', myThid myBuf%r8Values = myBuf%r8Values*alpha ELSE ! PRINT *, ' HELLO 6 NOT ASSOCIATED ', myThid ENDIF ENDIF ENDDO RETURN END SUBROUTINE SUBROUTINE SRDIAG_STORE( diagVar, curTime, myThid ) TYPE(SRDIAG_SPEC), POINTER :: diagVar INTEGER :: myThid REAL*8 :: curTime INTEGER :: iUnit INTEGER :: NB INTEGER :: I, rr, fr, J INTEGER*8 :: iLo8, iHi8, jLo8, jHi8, & kLo8, kHi8 INTEGER*8 :: rr8 INTEGER*8 :: npt8 CHARACTER*512 :: fC512 INTEGER*4 :: dFlag4 CHARACTER*8 :: vString INTEGER :: dFPointsStruct INTEGER :: dFPointsUnStruct INTEGER :: dFData PARAMETER ( vString = 'v001 ', & dFPointsStruct = 0, & dFPointsUnStruct = 1, & dFData = 2 ) CALL MDSFINDUNIT( iUnit, myThid ) OPEN(unit=iUnit,file=TRIM(diagVar%outName), & FORM='unformatted',STATUS='OLD', & POSITION='APPEND') IF ( diagVar%vWritten .EQV. .FALSE. ) THEN WRITE(iunit) vString diagVar%vWritten = .TRUE. ENDIF IF ( .NOT. ASSOCIATED(diagVar%bList) ) THEN CLOSE( iUnit ) RETURN ENDIF ! Need to store each code for each region ! Use following format for data ! "dflag4bytes" "fieldcode512bytes" "regionRank8bytes" "time8bytes" "npoints8bytes" (data8bytes) x npoints ! On first write need to write index ranges for the code and region ! (for scatter point set) ! "dflag4bytes" "fieldcode512bytes" "regionRank8bytes" "avPeriodr8" "npoints8bytes" (ival8bytes jval8bytes kval8bytes) x npoints ! -or- (for structured point set) ! "dflag4bytes" "fieldcode512bytes" "regionRank8bytes" "avPeriod8" ilo8bytes ihi8bytes jlo8bytes jhi8bytes klo8bytes khi8bytes NB = UBOUND(diagVar%bList,1) DO I = 1, NB IF ( ASSOCIATED(diagVar%bList(I)%r8Values) ) THEN ! This buffer has some data rr = diagVar%bList(I)%regionRank fr = diagVar%bList(I)%fCodeRank rr8 = rr npt8 = UBOUND(diagVar%bList(I)%r8Values,1) fC512 = TRIM(diagVar%cList(fr)%fCode) IF ( diagVar%bList(I)%metaWritten .EQV. .FALSE. ) THEN ! Write meta data if it hasn't already been written iLo8 = MAX(LBOUND(diagVar%mList(rr)%mask,1), & diagVar%mList(rr)%iLo & ) iHi8 = MIN(UBOUND(diagVar%mList(rr)%mask,1), & diagVar%mList(rr)%iLo+ & diagVar%mList(rr)%nX-1 & ) jLo8 = MAX(LBOUND(diagVar%mList(rr)%mask,2), & diagVar%mList(rr)%jLo & ) jHi8 = MIN(UBOUND(diagVar%mList(rr)%mask,2), & diagVar%mList(rr)%jLo+ & diagVar%mList(rr)%nY-1 & ) kLo8 = MAX(LBOUND(diagVar%mList(rr)%mask,3), & diagVar%mList(rr)%kLo & ) kHi8 = MIN(UBOUND(diagVar%mList(rr)%mask,3), & diagVar%mList(rr)%kLo+ & diagVar%mList(rr)%nR-1 & ) WRITE(iUnit) dFPointsStruct, fC512, rr8, diagVar%aPeriod, & iLo8, iHi8, jLo8, jHi8, kLo8, kHi8 diagVar%bList(I)%metaWritten = .TRUE. ENDIF ! Now write the data diagVar%bList(I)%r8Values= & diagVar%bList(I)%r8Values/diagVar%aPeriod WRITE(iUnit) dfData, fc512, rr8, curTime, npt8, & (diagVar%bList(I)%r8Values(J),J=1,npt8 ) diagVar%bList(I)%r8Values=0. ! WRITE(iunit) 1.0 ENDIF ENDDO CLOSE(iUnit) RETURN END SUBROUTINE END MODULE