C $Header: /u/gcmpack/MITgcm/pkg/aim_v23/aim_diagnostics.F,v 1.25 2017/03/24 23:31:41 jmc Exp $
C $Name: $
#include "AIM_OPTIONS.h"
CBOP
C !ROUTINE: AIM_DIAGNOSTICS
C !INTERFACE:
SUBROUTINE AIM_DIAGNOSTICS( bi, bj, myTime, myIter, myThid )
C !DESCRIPTION: \bv
C *==========================================================*
C | S/R AIM_DIAGNOSTICS
C | o Calculate AIM diagnostics
C *==========================================================*
C \ev
C !USES:
IMPLICIT NONE
C == Global variables ===
C-- size for MITgcm & Physics package :
#include "AIM_SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "AIM_PARAMS.h"
c #include "AIM2DYN.h"
#include "AIM_TAVE.h"
#include "com_physvar.h"
#include "com_forcing.h"
C !INPUT/OUTPUT PARAMETERS:
C == Routine arguments ==
C bi,bj :: Tile index
C myTime :: Current time of simulation ( s )
C myIter :: Current iteration number in simulation
C myThid :: Number of this instance of the routine
INTEGER bi, bj
_RL myTime
INTEGER myIter, myThid
CEOP
#ifdef ALLOW_AIM
C !FUNCTIONS:
LOGICAL DIFFERENT_MULTIPLE
EXTERNAL
#ifdef ALLOW_DIAGNOSTICS
LOGICAL DIAGNOSTICS_IS_ON
EXTERNAL
#endif
C !LOCAL VARIABLES:
C == Local variables ==
INTEGER I,J,K, I2,Katm
_RL DDTT
CHARACTER*(10) suff
#ifdef ALLOW_DIAGNOSTICS
_RL tmpVar(NGP)
#endif
#ifdef ALLOW_MNC
CHARACTER*(1) pf
#endif
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
C-- mean surf. temp. change:
C note: comment out ice-free ocean contribution (small part anyway)
C which is not yet available when this S/R is called
DO J=1,NGP
dTsurf(J,1,myThid) = fMask1(J,1,myThid)*dTsurf(J,1,myThid)
c & + fMask1(J,2,myThid)*dTsurf(J,2,myThid)
& + fMask1(J,3,myThid)*dTsurf(J,3,myThid)
dTsurf(J,1,myThid) = ABS(dTsurf(J,1,myThid))
ENDDO
IF ( DIFFERENT_MULTIPLE( aim_tendFreq,
& myTime+deltaTClock, deltaTClock )
& ) THEN
C--- Write Tendencies to files :
IF ( aim_snapshot_mdsio ) THEN
C- using MDSIO based S/R
IF ( rwSuffixType.EQ.0 ) THEN
WRITE(suff,'(I10.10)') myIter+1
ELSE
CALL RW_GET_SUFFIX( suff,
& myTime+deltaTClock, myIter+1, myThid )
ENDIF
CALL AIM_WRITE_PHYS( 'aim_dT_RSW.', suff, Nr, TT_RSW,
& 0, bi, bj, 1, myIter, myThid )
CALL AIM_WRITE_PHYS( 'aim_dT_RLW.', suff, Nr, TT_RLW,
& 0, bi, bj, 1, myIter, myThid )
CALL AIM_WRITE_PHYS( 'aim_dT_CNV.', suff, Nr, TT_CNV,
& 0, bi, bj, 1, myIter, myThid )
CALL AIM_WRITE_PHYS( 'aim_dT_PBL.', suff, Nr, TT_PBL,
& 0, bi, bj, 1, myIter, myThid )
CALL AIM_WRITE_PHYS( 'aim_dT_LSC.', suff, Nr, TT_LSC,
& 0, bi, bj, 1, myIter, myThid )
CALL AIM_WRITE_PHYS( 'aim_dQ_CNV.', suff, Nr, QT_CNV,
& 0, bi, bj, 1, myIter, myThid )
CALL AIM_WRITE_PHYS( 'aim_dQ_PBL.', suff, Nr, QT_PBL,
& 0, bi, bj, 1, myIter, myThid )
CALL AIM_WRITE_PHYS( 'aim_dQ_LSC.', suff, Nr, QT_LSC,
& 0, bi, bj, 1, myIter, myThid )
#ifdef ALLOW_CLR_SKY_DIAG
C- write clear-sky tendencies to files :
IF ( aim_clrSkyDiag ) THEN
CALL AIM_WRITE_PHYS( 'aim_dT_clskySW.', suff, Nr, TT_SWclr,
& 0, bi, bj, 1, myIter, myThid )
CALL AIM_WRITE_PHYS( 'aim_dT_clskyLW.', suff, Nr, TT_LWclr,
& 0, bi, bj, 1, myIter, myThid )
ENDIF
#endif /* ALLOW_CLR_SKY_DIAG */
C- end if aim_snapshot_mdsio
ENDIF
#ifdef ALLOW_MNC
c IF ( useMNC .AND. aim_snapshot_mnc ) THEN
C- using MNC S/R
IF ( .FALSE. ) THEN
C jmc: temporary turn off this part until this get fixed:
C > MNC_CW_RL_W ERROR: vtype 'aim_dT_RSW' is not defined
IF ( writeBinaryPrec .EQ. precFloat64 ) THEN
pf(1:1) = 'D'
ELSE
pf(1:1) = 'R'
ENDIF
IF ( bi.EQ.1 .AND. bj.EQ.1 ) THEN
WRITE(suff,'(a)') 'aim_tend'
CALL MNC_CW_SET_UDIM(suff, -1, myThid)
CALL MNC_CW_RL_W_S('D',suff,0,0,'T',myTime,myThid)
CALL MNC_CW_SET_UDIM(suff, 0, myThid)
CALL MNC_CW_I_W_S('I',suff,0,0,'iter',myIter,myThid)
ENDIF
CALL MNC_CW_RL_W(pf,suff,bi,bj,'aim_dT_RSW',TT_RSW,myThid)
CALL MNC_CW_RL_W(pf,suff,bi,bj,'aim_dT_RLW',TT_RLW,myThid)
CALL MNC_CW_RL_W(pf,suff,bi,bj,'aim_dT_CNV',TT_CNV,myThid)
CALL MNC_CW_RL_W(pf,suff,bi,bj,'aim_dT_PBL',TT_PBL,myThid)
CALL MNC_CW_RL_W(pf,suff,bi,bj,'aim_dT_LSC',TT_LSC,myThid)
CALL MNC_CW_RL_W(pf,suff,bi,bj,'aim_dQ_CNV',QT_CNV,myThid)
CALL MNC_CW_RL_W(pf,suff,bi,bj,'aim_dQ_PBL',QT_PBL,myThid)
CALL MNC_CW_RL_W(pf,suff,bi,bj,'aim_dQ_LSC',QT_LSC,myThid)
C- end if aim_snapshot_mnc
ENDIF
#endif /* ALLOW_MNC */
C--- end writing tendencies
ENDIF
IF ( DIFFERENT_MULTIPLE( aim_diagFreq,
& myTime+deltaTClock, deltaTClock )
& ) THEN
C--- Write Physics Fields
IF ( aim_snapshot_mdsio ) THEN
C- using MDSIO based S/R
IF ( rwSuffixType.EQ.0 ) THEN
WRITE(suff,'(I10.10)') myIter+1
ELSE
CALL RW_GET_SUFFIX( suff,
& myTime+deltaTClock, myIter+1, myThid )
ENDIF
C-- Write Relative Humidity :
CALL AIM_WRITE_PHYS( 'aim_RelHum.', suff, Nr, RH,
& 0, bi, bj, 1, myIter, myThid )
C-- Write AIM Physics diagnostics (2D, all in 1 file) :
CALL AIM_WRITE_PHYS( 'aimPhyDiag.', suff, 4, DRAG,
& 1, bi, bj, 1, myIter, myThid )
CALL AIM_WRITE_PHYS( 'aimPhyDiag.', suff, 1, SPEED0,
& 1, bi, bj, 2, myIter, myThid )
CALL AIM_WRITE_PHYS( 'aimPhyDiag.', suff, 1, TSR,
& 1, bi, bj, 3, myIter, myThid )
CALL AIM_WRITE_PHYS( 'aimPhyDiag.', suff, 1, OLR,
& 1, bi, bj, 4, myIter, myThid )
CALL AIM_WRITE_PHYS( 'aimPhyDiag.', suff, 4, SSR,
& 1, bi, bj, 5, myIter, myThid )
CALL AIM_WRITE_PHYS( 'aimPhyDiag.', suff, 4, SLR,
& 1, bi, bj, 6, myIter, myThid )
CALL AIM_WRITE_PHYS( 'aimPhyDiag.', suff, 4, SHF,
& 1, bi, bj, 7, myIter, myThid )
CALL AIM_WRITE_PHYS( 'aimPhyDiag.', suff, 4, EVAP,
& 1, bi, bj, 8, myIter, myThid )
CALL AIM_WRITE_PHYS( 'aimPhyDiag.', suff, 1, PRECNV,
& 1, bi, bj, 9, myIter, myThid )
CALL AIM_WRITE_PHYS( 'aimPhyDiag.', suff, 1, PRECLS,
& 1, bi, bj,10, myIter, myThid )
CALL AIM_WRITE_PHYS( 'aimPhyDiag.', suff, 1, CLOUDC,
& 1, bi, bj,11, myIter, myThid )
CALL AIM_WRITE_PHYS( 'aimPhyDiag.', suff, 1, CLTOP,
& 1, bi, bj,12, myIter, myThid )
CALL AIM_WRITE_PHYS( 'aimPhyDiag.', suff, 1, CBMF,
& 1, bi, bj,13, myIter, myThid )
CALL AIM_WRITE_PHYS( 'aimPhyDiag.', suff, 1, T0,
& 1, bi, bj,14, myIter, myThid )
CALL AIM_WRITE_PHYS( 'aimPhyDiag.', suff, 1, Q0,
& 1, bi, bj,15, myIter, myThid )
CALL AIM_WRITE_PHYS( 'aimPhyDiag.', suff, 1, EnPrec,
& 1, bi, bj,16, myIter, myThid )
CALL AIM_WRITE_PHYS( 'aimPhyDiag.', suff, 4, alb1,
& 1, bi, bj,17, myIter, myThid )
CALL AIM_WRITE_PHYS( 'aimPhyDiag.', suff, 3, dTsurf,
& 1, bi, bj,18, myIter, myThid )
#ifdef ALLOW_CLR_SKY_DIAG
C-- write clear-sky radiative fluxes to files :
IF ( aim_clrSkyDiag ) THEN
CALL AIM_WRITE_PHYS('aimPhyDiag.', suff, 1, TSWclr,
& 1, bi, bj,19, myIter, myThid )
CALL AIM_WRITE_PHYS('aimPhyDiag.', suff, 1, OLWclr,
& 1, bi, bj,20, myIter, myThid )
CALL AIM_WRITE_PHYS('aimPhyDiag.', suff, 1, SSWclr,
& 1, bi, bj,21, myIter, myThid )
CALL AIM_WRITE_PHYS('aimPhyDiag.', suff, 1, SLWclr,
& 1, bi, bj,22, myIter, myThid )
ENDIF
#endif /* ALLOW_CLR_SKY_DIAG */
C- end if aim_snapshot_mdsio
ENDIF
#ifdef ALLOW_MNC
IF ( useMNC .AND. aim_snapshot_mnc ) THEN
C- using MNC S/R
IF ( writeBinaryPrec .EQ. precFloat64 ) THEN
pf(1:1) = 'D'
ELSE
pf(1:1) = 'R'
ENDIF
IF ( bi.EQ.1 .AND. bj.EQ.1 ) THEN
WRITE(suff,'(a)') 'aim_phys'
CALL MNC_CW_SET_UDIM(suff, -1, myThid)
CALL MNC_CW_RL_W_S('D',suff,0,0,'T',myTime+deltaTClock,myThid)
CALL MNC_CW_SET_UDIM(suff, 0, myThid)
CALL MNC_CW_I_W_S('I',suff,0,0,'iter',myIter+1,myThid)
ENDIF
CALL MNC_CW_RL_W(pf,suff,bi,bj,
& 'aim_DRAG0',DRAG(1,0,myThid),myThid)
CALL MNC_CW_RL_W(pf,suff,bi,bj,
& 'aim_SPEED0',SPEED0(1,myThid),myThid)
CALL MNC_CW_RL_W(pf,suff,bi,bj,
& 'aim_TSR',TSR(1,myThid),myThid)
CALL MNC_CW_RL_W(pf,suff,bi,bj,
& 'aim_OLR',OLR(1,myThid),myThid)
CALL MNC_CW_RL_W(pf,suff,bi,bj,
& 'aim_SSR0',SSR(1,0,myThid),myThid)
CALL MNC_CW_RL_W(pf,suff,bi,bj,
& 'aim_SLR0',SLR(1,0,myThid),myThid)
CALL MNC_CW_RL_W(pf,suff,bi,bj,
& 'aim_SHF0',SHF(1,0,myThid),myThid)
CALL MNC_CW_RL_W(pf,suff,bi,bj,
& 'aim_EVAP0',EVAP(1,0,myThid),myThid)
CALL MNC_CW_RL_W(pf,suff,bi,bj,
& 'aim_PRECNV',PRECNV(1,myThid),myThid)
CALL MNC_CW_RL_W(pf,suff,bi,bj,
& 'aim_PRECLS',PRECLS(1,myThid),myThid)
CALL MNC_CW_RL_W(pf,suff,bi,bj,
& 'aim_CLOUDC',CLOUDC(1,myThid),myThid)
CALL MNC_CW_RL_W(pf,suff,bi,bj,
& 'aim_CLTOP',CLTOP(1,myThid),myThid)
CALL MNC_CW_RL_W(pf,suff,bi,bj,
& 'aim_CBMF',CBMF(1,myThid),myThid)
CALL MNC_CW_RL_W(pf,suff,bi,bj,
& 'aim_T0',T0(1,myThid),myThid)
CALL MNC_CW_RL_W(pf,suff,bi,bj,
& 'aim_Q0',Q0(1,myThid),myThid)
CALL MNC_CW_RL_W(pf,suff,bi,bj,
& 'aim_EnPrec',EnPrec(1,myThid),myThid)
CALL MNC_CW_RL_W(pf,suff,bi,bj,
& 'aim_alb10',alb1(1,0,myThid),myThid)
CALL MNC_CW_RL_W(pf,suff,bi,bj,
& 'aim_dTsurf1',dTsurf(1,1,myThid),myThid)
#ifdef ALLOW_CLR_SKY_DIAG
C-- write clear-sky radiative fluxes to files :
IF ( aim_clrSkyDiag ) THEN
CALL MNC_CW_RL_W(pf,suff,bi,bj,
& 'aim_TSWclr',TSWclr(1,myThid),myThid)
CALL MNC_CW_RL_W(pf,suff,bi,bj,
& 'aim_OLWclr',OLWclr(1,myThid),myThid)
CALL MNC_CW_RL_W(pf,suff,bi,bj,
& 'aim_SSWclr',SSWclr(1,myThid),myThid)
CALL MNC_CW_RL_W(pf,suff,bi,bj,
& 'aim_SLWclr',SLWclr(1,myThid),myThid)
ENDIF
#endif /* ALLOW_CLR_SKY_DIAG */
C end if aim_snapshot_mnc
ENDIF
#endif /* ALLOW_MNC */
C-- end writing Physics Fields
ENDIF
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
C-- cloud-top pressure: multiplied by cloud fraction before averaging:
DO J=1,NGP
CLTOP(J,myThid)=CLTOP(J,myThid)*CLOUDC(J,myThid)
ENDDO
#ifdef ALLOW_AIM_TAVE
IF ( aim_taveFreq.GT.0. ) THEN
DDTT = deltaTClock
DO J=1,sNy
DO I=1,sNx
I2 = I+(J-1)*sNx
TSRtave(i,j,bi,bj) = TSRtave(i,j,bi,bj)
& + TSR(I2,myThid)*DDTT
OLRtave(i,j,bi,bj) = OLRtave(i,j,bi,bj)
& + OLR(I2,myThid)*DDTT
SSRtave(i,j,bi,bj) = SSRtave(i,j,bi,bj)
& + SSR(I2,0,myThid)*DDTT
SLRtave(i,j,bi,bj) = SLRtave(i,j,bi,bj)
& + SLR(I2,0,myThid)*DDTT
SHFtave(i,j,bi,bj) = SHFtave(i,j,bi,bj)
& + SHF(I2,0,myThid)*DDTT
EVAPtave(i,j,bi,bj) = EVAPtave(i,j,bi,bj)
& + EVAP(I2,0,myThid)*DDTT
PRECNVtave(i,j,bi,bj) = PRECNVtave(i,j,bi,bj)
& + PRECNV(I2,myThid)*DDTT
PRECLStave(i,j,bi,bj) = PRECLStave(i,j,bi,bj)
& + PRECLS(I2,myThid)*DDTT
CLOUDCtave(i,j,bi,bj) = CLOUDCtave(i,j,bi,bj)
& + CLOUDC(I2,myThid)*DDTT
CLTOPtave(i,j,bi,bj) = CLTOPtave(i,j,bi,bj)
& + CLTOP(I2,myThid)*DDTT
CBMFtave(i,j,bi,bj) = CBMFtave(i,j,bi,bj)
& + CBMF(I2,myThid)*DDTT
DRAGtave(i,j,bi,bj) = DRAGtave(i,j,bi,bj)
& + DRAG(I2,0,myThid)*DDTT
aimV0tave(i,j,bi,bj) = aimV0tave(i,j,bi,bj)
& + SPEED0(I2,myThid)*DDTT
aimT0tave(i,j,bi,bj) = aimT0tave(i,j,bi,bj)
& + T0(I2,myThid)*DDTT
aimQ0tave(i,j,bi,bj) = aimQ0tave(i,j,bi,bj)
& + Q0(I2,myThid)*DDTT
EnFxPrtave(i,j,bi,bj) = EnFxPrtave(i,j,bi,bj)
& + EnPrec(I2,myThid)
& *(PRECNV(I2,myThid)+
& PRECLS(I2,myThid))*DDTT
albedotave(i,j,bi,bj) = albedotave(i,j,bi,bj)
& + alb1(I2,0,myThid)*DDTT
dTsurftave(i,j,bi,bj) = dTsurftave(i,j,bi,bj)
& + dTsurf(I2,1,myThid)*DDTT
ENDDO
ENDDO
C- Relative Humidity :
DO k=1,Nr
Katm = _KD2KA( k )
DO j=1,sNy
DO i=1,sNx
I2 = i+(j-1)*sNx
aimRHtave(i,j,k,bi,bj) = aimRHtave(i,j,k,bi,bj)
& + RH(I2,Katm,myThid)*DDTT
ENDDO
ENDDO
ENDDO
C- Keep record of how much time has been integrated over
aim_timeAve(bi,bj) = aim_timeAve(bi,bj)+DDTT
ENDIF
#endif /* ALLOW_AIM_TAVE */
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
#ifdef ALLOW_DIAGNOSTICS
IF ( useDiagnostics ) THEN
CALL DIAGNOSTICS_FILL( TT_RSW(1,1,myThid),
& 'RADSW ',-1, Nr, 3,bi,bj, myThid )
CALL DIAGNOSTICS_FILL( TT_RLW(1,1,myThid),
& 'RADLW ',-1, Nr, 3,bi,bj, myThid )
CALL DIAGNOSTICS_FILL( TT_CNV(1,1,myThid),
& 'DTCONV ',-1, Nr, 3,bi,bj, myThid )
CALL DIAGNOSTICS_FILL( TT_PBL(1,1,myThid),
& 'TURBT ',-1, Nr, 3,bi,bj, myThid )
CALL DIAGNOSTICS_FILL( TT_LSC(1,1,myThid),
& 'DTLS ',-1, Nr, 3,bi,bj, myThid )
CALL DIAGNOSTICS_FILL( QT_CNV(1,1,myThid),
& 'DQCONV ',-1, Nr, 3,bi,bj, myThid )
CALL DIAGNOSTICS_FILL( QT_PBL(1,1,myThid),
& 'TURBQ ',-1, Nr, 3,bi,bj, myThid )
CALL DIAGNOSTICS_FILL( QT_LSC(1,1,myThid),
& 'DQLS ',-1, Nr, 3,bi,bj, myThid )
CALL DIAGNOSTICS_FILL( RH(1,1,myThid),
& 'RELHUM ',-1, Nr, 3,bi,bj, myThid )
CALL DIAGNOSTICS_FILL( TSR(1,myThid),
& 'TSR ', 1, 1 , 3,bi,bj, myThid )
CALL DIAGNOSTICS_FILL( OLR(1,myThid),
& 'OLR ', 1, 1 , 3,bi,bj, myThid )
CALL DIAGNOSTICS_FILL( SSR(1,0,myThid),
& 'RADSWG ', 1, 1 , 3,bi,bj, myThid )
CALL DIAGNOSTICS_FILL( SLR(1,0,myThid),
& 'RADLWG ', 1, 1 , 3,bi,bj, myThid )
CALL DIAGNOSTICS_FILL( SHF(1,0,myThid),
& 'HFLUX ', 1, 1 , 3,bi,bj, myThid )
CALL DIAGNOSTICS_FILL( EVAP(1,0,myThid),
& 'EVAP ', 1, 1 , 3,bi,bj, myThid )
CALL DIAGNOSTICS_FILL( PRECNV(1,myThid),
& 'PRECON ', 1, 1 , 3,bi,bj, myThid )
CALL DIAGNOSTICS_FILL( PRECLS(1,myThid),
& 'PRECLS ', 1, 1 , 3,bi,bj, myThid )
CALL DIAGNOSTICS_FILL( CLOUDC(1,myThid),
& 'CLDFRC ', 1, 1 , 3,bi,bj, myThid )
CALL DIAGNOSTICS_FILL( CLTOP(1,myThid),
& 'CLDPRS ', 1, 1 , 3,bi,bj, myThid )
c CALL DIAGNOSTICS_FILL( CLOUDC(1,myThid),
c & 'CTPCNT ', 1, 1 , 3,bi,bj, myThid )
CALL DIAGNOSTICS_FILL( CBMF(1,myThid),
& 'CLDMAS ', 1, 1 , 3,bi,bj, myThid )
CALL DIAGNOSTICS_FILL( DRAG(1,0,myThid),
& 'DRAG ', 1, 1 , 3,bi,bj, myThid )
CALL DIAGNOSTICS_FILL( SPEED0(1,myThid),
& 'WINDS ', 1, 1 , 3,bi,bj, myThid )
CALL DIAGNOSTICS_FILL( T0(1,myThid),
& 'TS ', 1, 1 , 3,bi,bj, myThid )
CALL DIAGNOSTICS_FILL( Q0(1,myThid),
& 'QS ', 1, 1 , 3,bi,bj, myThid )
IF ( DIAGNOSTICS_IS_ON('ENPREC ',myThid) ) THEN
DO J=1,NGP
tmpVar(J) = EnPrec(J,myThid)
& *(PRECNV(J,myThid)+PRECLS(J,myThid))
ENDDO
CALL DIAGNOSTICS_FILL( tmpVar,
& 'ENPREC ', 1, 1 , 3,bi,bj, myThid )
ENDIF
CALL DIAGNOSTICS_FILL( alb1(1,0,myThid),
& 'ALBVISDF', 1, 1 , 3,bi,bj, myThid )
CALL DIAGNOSTICS_FILL( dTsurf(1,1,myThid),
& 'DTSIMPL ', 1, 1 , 3,bi,bj, myThid )
#ifdef ALLOW_CLR_SKY_DIAG
IF ( aim_clrSkyDiag ) THEN
CALL DIAGNOSTICS_FILL( TT_SWclr(1,1,myThid),
& 'SWCLR ',-1, Nr, 3,bi,bj, myThid )
CALL DIAGNOSTICS_FILL( TT_LWclr(1,1,myThid),
& 'LWCLR ',-1, Nr, 3,bi,bj, myThid )
CALL DIAGNOSTICS_FILL( TSWclr(1,myThid),
& 'TSRCLR ', 1, 1 , 3,bi,bj, myThid )
CALL DIAGNOSTICS_FILL( OLWclr(1,myThid),
& 'OLRCLR ', 1, 1 , 3,bi,bj, myThid )
CALL DIAGNOSTICS_FILL( SSWclr(1,myThid),
& 'SWGCLR ', 1, 1 , 3,bi,bj, myThid )
CALL DIAGNOSTICS_FILL( SLWclr(1,myThid),
& 'LWGCLR ', 1, 1 , 3,bi,bj, myThid )
ENDIF
#endif /* ALLOW_CLR_SKY_DIAG */
ENDIF
#endif /* ALLOW_DIAGNOSTICS */
#endif /* ALLOW_AIM */
RETURN
END