SUBROUTINE IMPLSCH (FL3, FL, IJS, IJL, IG, &
& THWOLD, USOLD, &
& TAUW, Z0OLD, &
& ROAIRO, ZIDLOLD, &
& U10NEW, THWNEW, USNEW, &
& Z0NEW, ROAIRN, ZIDLNEW, &
& SL, FCONST)
! ----------------------------------------------------------------------
!**** *IMPLSCH* - IMPLICIT SCHEME FOR TIME INTEGRATION OF SOURCE
!**** FUNCTIONS.
! S.D.HASSELMANN. MPI
! H. GUENTHER AND L. ZAMBRESKY OPTIMIZATION PERFORMED.
! H. GUENTHER GKSS/ECMWF OCTOBER 1989 NEW WIND FIELD
! INTERFACE AND
! TIME COUNTING
! P.A.E.M. JANSSEN KNMI AUGUST 1990 COUPLED MODEL
! H. GUENTHER GKSS/ECMWF JUNE 1991 NEW SEPARATION OF
! DIAG- AND PROGNOSTIC
! PART OF SPECTRUM.
! P.A.E.M. JANSSEN ECMWF FEBRUARY 1995 ADD MINIMUM VALUE
! (FLMIN).
! J. BIDLOT ECMWF FEBRUARY 1996 MESSAGE PASSING
! J. BIDLOT ECMWF FEBRUARY 1997 MESSAGE PASSING
! J. BIDLOT ECMWF FEBRUARY 2001 MODIFY CALLING ORDER
! BETWEEN SINPUT-STRESSO-AIRSEA
! S. ABDALLA ECMWF OCTOBER 2001
! INCLUSION OF AIR DENSITY AND Zi/L.
!* PURPOSE.
! --------
! THE IMPLICIT SCHEME ENABLES THE USE OF A TIMESTEP WHICH IS
! LARGE COMPARED WITH THE CHARACTERISTIC DYNAMIC TIME SCALE.
! THE SCHEME IS REQUIRED FOR THE HIGH FREQUENCIES WHICH
! RAPIDLY ADJUST TO A QUASI-EQUILIBRIUM.
!** INTERFACE.
! ----------
! *CALL* *IMPLSCH (FL3, FL, IJS, IJL, IG,
! 1 THWOLD,USOLD,TAUW,Z0OLD,ROAIRO,ZIDLOLD,
! 2 U10NEW,THWNEW,USNEW,Z0NEW,ROAIRN,ZIDLNEW,
! 3 SL,FCONST)
! *FL3* - FREQUENCY SPECTRUM(INPUT AND OUTPUT).
! *FL* - DIAGONAL MATRIX OF FUNCTIONAL DERIVATIVE
! *IJS* - INDEX OF FIRST GRIDPOINT
! *IJL* - INDEX OF LAST GRIDPOINT
! *IG* - BLOCK NUMBER
! *U10NEW* NEW WIND SPEED IN M/S.
! *THWNEW* WIND DIRECTION IN RADIANS IN OCEANOGRAPHIC
! NOTATION (POINTING ANGLE OF WIND VECTOR,
! CLOCKWISE FROM NORTH).
! *THWOLD* INTERMEDIATE STORAGE OF ANGLE (RADIANS) OF
! WIND VELOCITY.
! *USNEW* NEW FRICTION VELOCITY IN M/S.
! *USOLD* INTERMEDIATE STORAGE OF MODULUS OF FRICTION
! VELOCITY.
! *Z0NEW* ROUGHNESS LENGTH IN M.
! *Z0OLD* INTERMEDIATE STORAGE OF ROUGHNESS LENGTH IN
! M.
! *TAUW* WAVE STRESS IN (M/S)**2
! *ROAIRN* AIR DENSITY IN KG/M3.
! *ROAIRO* INTERMEDIATE STORAGE OF AIR DENSITY.
! *ZIDLNEW* Zi/L (Zi: INVERSION HEIGHT, L: MONIN-OBUKHOV LENGTH).
! *ZIDLOLD* INTERMEDIATE STORAGE OF Zi/L.
! *SL* REAL TOTAL SOURCE FUNCTION ARRAY.
! *FCONST* REAL = 1 FOR PROGNOSTIC FREQUENCY BANDS.
! = 0 FOR DIAGNOSTIC FREQUENCY BANDS.
! METHOD.
! -------
! THE SPECTRUM AT TIME (TN+1) IS COMPUTED AS
! FN+1=FN+DELT*(SN+SN+1)/2., WHERE SN IS THE TOTAL SOURCE
! FUNCTION AT TIME TN, SN+1=SN+(DS/DF)*DF - ONLY THE DIAGONAL
! TERMS OF THE FUNCTIONAL MATRIX DS/DF ARE YOWPUTED, THE
! NONDIAGONAL TERMS ARE NEGLIGIBLE.
! THE ROUTINE IS CALLED AFTER PROPAGATION FOR TIME PERIOD
! BETWEEN TWO PROPAGATION CALLS - ARRAY FL3 CONTAINS THE
! SPECTRUM AND FL IS USED AS AN INTERMEDIATE STORAGE FOR THE
! DIAGONAL TERM OF THE FUNCTIONAL MATRIX.
! EXTERNALS.
! ---------
! *AIRSEA* - SURFACE LAYER STRESS AND ROUGHNESS LENGTH.
! *CREWFN* - CREATE A WIND FILE NAME.
! *FEMEAN* - COMPUTATION OF MEAN FREQUENCY AT EACH GRID POINT.
! *INCDATE* - UPDATE DATE TIME GROUP.
!SHALLOW
! *SBOTTOM* - COMPUTES BOTTOM DISSIPATION SOURCE TERM AND
! LINEAR CONTRIBUTION TO FUNCTIONAL MATRIX.
!SHALLOW
! *SDISSIP* - COMPUTATION OF DISSIPATION SOURCE FUNCTION
! AND LINEAR CONTRIBUTION OF DISSIPATION TO
! FUNCTIONAL MATRIX IN IMPLICIT SCHEME.
! *SEMEAN* - COMPUTATION OF TOTAL ENERGY AT EACH GRID POINT.
! *SINPUT* - COMPUTATION OF INPUT SOURCE FUNCTION, AND
! LINEAR CONTRIBUTION OF INPUT SOURCE FUNCTION
! TO FUNCTIONAL MATRIX IN IMPLICIT SCHEME.
! *SNONLIN* - COMPUTATION OF NONLINEAR TRANSFER RATE AND
! DIAGONAL LINEAR CONTRIBUTION OF NONLINEAR SOURCE
! FUNCTION TO FUNCTIONAL MATRIX.
! *STRESSO* - COMPUTATION NORMALISED WAVE STRESS.
! !!!!!!! MAKE SURE THAT SINPUT IS CALLED FIRST, STRESSO
! !!!!!!! NEXT, AND THEN THE REST OF THE SOURCE FUNCTIONS.
! *FRCUTINDEX*
! REFERENCE.
! ----------
! S. HASSELMANN AND K. HASSELMANN, "A GLOBAL WAVE MODEL",
! 30/6/85 (UNPUBLISHED NOTE)
! ----------------------------------------------------------------------
! USE YOWFRED , ONLY : FR ,DFIM ,DELTH ,FR5 , &
! & FRM5 ,COFRM4 ,WETAIL ,TH , &
! & C ,FRIC ,FLOGSPRDM1
! USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
! USE YOWICE , ONLY : FLMINFR
! USE YOWMEAN , ONLY : EMEAN ,FMEAN
! USE YOWPARAM , ONLY : NANG ,NFRE
! USE YOWPCONS , ONLY : G ,ZPI ,EPSMIN
! USE YOWSHAL , ONLY : DEPTH ,TCGOND ,TFAK ,INDEP
! USE YOWSTAT , ONLY : IDELT ,ISHALLO
! USE YOWTABL , ONLY : JUMAX ,DELU
! USE YOWTEST , ONLY : IU06 ,ITEST
USE DATAPOOL, ONLY : MNP, FR, WETAIL, FRTAIL, WP1TAIL, ISHALLO, FRINTF, COFRM4, CG, WK, &
& DFIM, DFIMOFR, DFFR, DFFR2, WK, RKIND, EMEAN, FMEAN, TH, RKIND, DELU, &
& JUMAX, DT4S, FRM5, IPHYS, LOUTWAM, CD, UFRIC, ALPHA_CH, Z0, ITEST, LCFLX,&
& DELTH => DDIR, &
& G => G9, &
& ZPI => PI2, &
& EPSMIN => SMALL, &
& NANG => MDC, &
& NFRE => MSC, &
& INDEP => DEP, &
& ROWATER => RHOW, &
& RHOAIR => RHOA
IMPLICIT NONE
! ----------------------------------------------------------------------
! ALLOCATED ARRAYS THAT ARE PASSED AS SUBROUTINE ARGUMENTS
REAL(rkind) :: FL(IJS:IJL,NANG,NFRE),FL3(IJS:IJL,NANG,NFRE),SL(IJS:IJL,NANG,NFRE)
REAL(rkind),DIMENSION(IJS:IJL,NFRE) :: FCONST
REAL(rkind),DIMENSION(IJS:IJL) :: THWOLD,USOLD,Z0OLD,TAUW, &
& ROAIRO,ZIDLOLD
REAL(rkind),DIMENSION(IJS:IJL) :: U10NEW,THWNEW,USNEW,Z0NEW, &
& ROAIRN,ZIDLNEW
REAL(rkind),DIMENSION(NANG,NFRE) :: SSDS,DSSDS,SSBF,DSSBF,SSNL4,DSSNL4,SSIN,DSSIN
! ----------------------------------------------------------------------
INTEGER :: IJ,IJS,IJL,K,L,M,IG,ILEV,IDELT,IU06
INTEGER :: MIJ(IJS:IJL)
INTEGER :: JU(IJS:IJL)
REAL(rkind) :: GTEMP1, GTEMP2, FLHAB, XJ, DELT, DELT5, XIMP, AKM1
REAL(rkind) :: AK2VGM1, XN, PHIDIAG, TAU
REAL(rkind), DIMENSION(NFRE) :: DELFL
REAL(rkind), DIMENSION(IJS:IJL) :: EMEANWS, FMEANWS, USFM, GADIAG
REAL(rkind), DIMENSION(IJS:IJL) :: F1MEAN, AKMEAN, XKMEAN
REAL(rkind), DIMENSION(IJS:IJL) :: PHIEPS, TAUOC, PHIAW
REAL(rkind), DIMENSION(IJS:IJL) :: TAUWLF,TAUWD,PHIAWDIAG,PHIAWUNR,PHIOC,PHIWA
REAL(rkind), DIMENSION(IJS:IJL,NANG) :: SPRD
REAL(rkind), DIMENSION(IJS:IJL,NFRE) :: TEMP, TEMP2
REAL(rkind), DIMENSION(IJS:IJL,NANG,NFRE) :: CIWAB
REAL(rkind), DIMENSION(IJS:IJL,NANG,NFRE) :: XLLWS
IDELT = INT(DT4S)
! REAL ZHOOK_HANDLE
! IF (LHOOK) CALL DR_HOOK('IMPLSCH',0,ZHOOK_HANDLE)
! ----------------------------------------------------------------------
!* 1. INITIALISATION.
! ---------------
! LCFLX=LWFLUX.OR.LWFLUXOUT.OR.LWNEMOCOU
! ----------------------------------------------------------------------
!* 2. COMPUTATION OF IMPLICIT INTEGRATION.
! ------------------------------------
! INTEGRATION IS DONE FROM CDATE UNTIL CDTPRO FOR A BLOCK
! OF LATITUDES BETWEEN PROPAGATION CALLS.
!* 2.2 COMPUTE MEAN PARAMETERS.
! ------------------------
CALL FKMEAN(FL3, IJS, IJL, EMEAN(IJS), FMEAN(IJS), &
& F1MEAN, AKMEAN, XKMEAN)
IF (LOUTWAM) WRITE(111113,*) 'HS and TM'
IF (LOUTWAM) WRITE(111113,'(10F15.7)') 4*SQRT(EMEAN(IJS)), FMEAN(IJS)
!WRITE(55555,*) 4*SQRT(EMEAN(IJS)), FMEAN(IJS)
IF (LOUTWAM) WRITE(111113,*) 'DIRECTIONAL PROPERTIES'
DO K=1,NANG
DO IJ=IJS,IJL
SPRD(IJ,K)=MAX(0.,COS(TH(K)-THWNEW(IJ)))**2
! WRITE(111113,'(I10,10F15.7)') K, SPRD(IJ,K), TH(K), THWNEW(IJ)
ENDDO
ENDDO
DO IJ=IJS,IJL
XJ=U10NEW(IJ)/DELU
JU(IJ)=MIN(JUMAX, MAX(NINT(XJ),1))
ENDDO
IF (LOUTWAM) WRITE(111113,*) 'SOME THINKS THAT DO NOT NEED TO BE ALWAYS RECOMPUTED'
IF (LOUTWAM) WRITE(111113,'(I10,10F15.7)') IJ,JU(IJS:IJL),JUMAX,MAX(NINT(XJ),1)
! ----------------------------------------------------------------------
!* 2.3 COMPUTATION OF SOURCE FUNCTIONS.
! --------------------------------
!* 2.3.1 INITIALISE SOURCE FUNCTION AND DERIVATIVE ARRAY.
! ------------------------------------------------
!! FL AND SL ARE INITIALISED IN SINPUT
ILEV=1
CALL AIRSEA (U10NEW(IJS), TAUW(IJS), USNEW(IJS), Z0NEW(IJS), &
& IJS, IJL, ILEV)
IF (ITEST.GE.2) THEN
WRITE(IU06,*) ' SUB. IMPLSCH: AIRSEA CALLED BEFORE DO LOOP'
CALL FLUSH (IU06)
ENDIF
IF (LOUTWAM) WRITE(111113,*) 'AFTER AIRSEA 1'
IF (LOUTWAM) WRITE(111113,'(I10,10F15.7)') IJS, U10NEW(IJS), TAUW(IJS), &
& USNEW(IJS), Z0NEW(IJS), ILEV
!* 2.3.2 ADD SOURCE FUNCTIONS AND WAVE STRESS.
! -------------------------------------
IF(IPHYS.EQ.0) THEN
CALL SINPUT (FL3, FL, IJS, IJL, THWNEW, USNEW, Z0NEW, &
& ROAIRN, ZIDLNEW, SL, XLLWS, SSIN, DSSIN)
ELSE
CALL SINPUT_ARD (FL3, FL, IJS, IJL, THWNEW, USNEW, Z0NEW, &
& ROAIRN, ZIDLNEW, SL, XLLWS, SSIN, DSSIN)
ENDIF
IF (LOUTWAM) WRITE(111113,*) 'AFTER SINPUT 1'
IF (LOUTWAM) WRITE(111113,'(I10,10F15.7)') IJS, SUM(FL), SUM(SL)
IF (ITEST.GE.2) THEN
WRITE(IU06,*) ' SUB. IMPLSCH: SINPUT CALLED'
CALL FLUSH (IU06)
ENDIF
! MEAN FREQUENCY CHARACTERISTIC FOR WIND SEA
CALL FEMEANWS(FL3,IJS,IJL,EMEANWS,FMEANWS,XLLWS)
! COMPUTE LAST FREQUENCY INDEX OF PROGNOSTIC PART OF SPECTRUM.
CALL FRCUTINDEX(IJS, IJL, FMEAN(IJS), FMEANWS, MIJ)
CALL STRESSO (FL3, IJS, IJL, THWNEW, USNEW, Z0NEW, &
& ROAIRN, TAUW, TAUWLF, PHIWA, &
& PHIAWDIAG, PHIAWUNR, SL, &
& MIJ, LCFLX)
IF (ITEST.GE.2) THEN
WRITE(IU06,*) ' SUB. IMPLSCH: STRESSO CALLED'
CALL FLUSH (IU06)
ENDIF
IF (LOUTWAM) WRITE(111113,*) 'AFTER STRESSO 1'
IF (LOUTWAM) WRITE(111113,'(2I10,15F15.7)') IJS, IJL, SUM(FL3), &
& THWNEW, USNEW, Z0NEW, &
& ROAIRN, TAUW, TAUWLF, PHIWA, &
& PHIAWDIAG, PHIAWUNR, SUM(SL), &
& MIJ
CALL AIRSEA (U10NEW(IJS), TAUW(IJS), USNEW(IJS), Z0NEW(IJS), &
& IJS, IJL, ILEV)
IF (LOUTWAM) WRITE(111113,*) 'AFTER AIRSEA 2'
IF (LOUTWAM) WRITE(111113,'(I10,10F15.7)') IJS, U10NEW(IJS), TAUW(IJS), &
& USNEW(IJS), Z0NEW(IJS)
IF (ITEST.GE.2) THEN
WRITE(IU06,*) ' SUB. IMPLSCH: AIRSEA CALLED'
CALL FLUSH (IU06)
ENDIF
! 2.3.3 ADD THE OTHER SOURCE TERMS.
! ---------------------------
CALL SNONLIN (FL3, FL, IJS, IJL, IG, SL, AKMEAN(IJS), SSNL4, DSSNL4)
IF (LOUTWAM) WRITE(111113,*) 'AFTER SNON'
IF (LOUTWAM) WRITE(111113,'(I10,10F15.7)') IJS, SUM(FL), SUM(SL)
IF (ITEST.GE.2) THEN
WRITE(IU06,*) ' SUB. IMPLSCH: SNONLIN CALLED'
CALL FLUSH (IU06)
ENDIF
IF(IPHYS.EQ.0) THEN
CALL SDISSIP (FL3 ,FL, IJS, IJL, IG, SL, F1MEAN, XKMEAN,&
& PHIOC, TAUWD, MIJ, SSDS, DSSDS)
ELSE
CALL SDISS_ARDH_VEC (FL3 ,FL, IJS, IJL, SL, F1MEAN, XKMEAN,&
& PHIOC, TAUWD, MIJ, SSDS, DSSDS)
ENDIF
IF (LOUTWAM) WRITE(111113,*) 'AFTER DISSIP'
IF (LOUTWAM) WRITE(111113,'(I10,10F15.7)') IJS, SUM(FL), SUM(SL)
IF (ITEST.GE.2) THEN
WRITE(IU06,*) ' SUB. IMPLSCH: SDISSIP CALLED'
CALL FLUSH (IU06)
ENDIF
!SHALLOW
!IF(ISHALLO.NE.1) CALL SBOTTOM (FL3, FL, IJS, IJL, IG, SL, SSBF, DSSBF)
!SHALLOW
IF (LOUTWAM) WRITE(111113,*) 'AFTER SBOTTOM'
IF (LOUTWAM) WRITE(111113,'(I10,10F15.7)') IJS, SUM(FL), SUM(SL)
! ----------------------------------------------------------------------
!* 2.4 COMPUTATION OF NEW SPECTRA.
! ---------------------------
! INCREASE OF SPECTRUM IN A TIME STEP IS LIMITED TO A FINITE
! FRACTION OF A TYPICAL F**(-4) EQUILIBRIUM SPECTRUM.
DELT = IDELT
XIMP = 1.0
DELT5 = XIMP*DELT
DO M=1,NFRE
DELFL(M) = COFRM4(M)*DELT
ENDDO
DO IJ=IJS,IJL
USFM(IJ) = USNEW(IJ)*MAX(FMEANWS(IJ),FMEAN(IJ))
IF (LOUTWAM) WRITE(111113,'(4F20.10)') USNEW(IJ), FMEANWS(IJ), FMEAN(IJ)
ENDDO
DO M=1,NFRE
DO IJ=IJS,IJL
TEMP(IJ,M) = USFM(IJ)*DELFL(M)
! WRITE(111113,'(4F20.10)') DELFL(M), COFRM4(M), DELT
ENDDO
ENDDO
! WRITE(111113,*) 'MORE TEST'
DO K=1,NANG
DO M=1,NFRE
DO IJ=IJS,IJL
GTEMP1 = MAX((1.-DELT5*FL(IJ,K,M)),1.)
GTEMP2 = DELT*SL(IJ,K,M)/GTEMP1
FLHAB = ABS(GTEMP2)
FLHAB = MIN(FLHAB,TEMP(IJ,M))
FL3(IJ,K,M) = FL3(IJ,K,M) + SIGN(FLHAB,GTEMP2)
!AR: ICE FLLOWEST = FLMINFR(JU(IJ),M)*SPRD(IJ,K)
!AR: ICE FL3(IJ,K,M) = MAX(FL3(IJ,K,M),FLLOWEST)
!IF (FL3(IJ,K,M) .LT. 0.d0) WRITE(111113,'(5F20.10)')GTEMP2,FLHAB,TEMP(IJ,M),FL(IJ,K,M),SL(IJ,K,M)
ENDDO
ENDDO
ENDDO
!IF (MINVAL(FL3) .LT. 0.d0) THEN
! WRITE(*,*) IJS, MINVAL(FL3)
!ENDIF
IF (LOUTWAM) WRITE(111113,*) 'AFTER INTEGRATION'
IF (LOUTWAM) WRITE(111113,'(I10,10F15.7)') IJS, SUM(FL), SUM(SL), SUM(FL3)
! ----------------------------------------------------------------------
!* 2.5 REPLACE DIAGNOSTIC PART OF SPECTRA BY A F**(-5) TAIL.
! -----------------------------------------------------
!* 2.5.1 COMPUTE MEAN PARAMETERS.
! ------------------------
CALL FKMEAN(FL3, IJS, IJL, EMEAN(IJS), FMEAN(IJS), &
& F1MEAN, AKMEAN, XKMEAN)
! MEAN FREQUENCY CHARACTERISTIC FOR WIND SEA
CALL FEMEANWS(FL3,IJS,IJL,EMEANWS,FMEANWS,XLLWS)
!* 2.5.3 COMPUTE TAIL ENERGY RATIOS.
! ---------------------------
! COMPUTE LAST FREQUENCY INDEX OF PROGNOSTIC PART OF SPECTRUM.
CALL FRCUTINDEX(IJS, IJL, FMEAN(IJS), FMEANWS, MIJ)
IF(ISHALLO.EQ.1) THEN
DO M=1,NFRE
DO IJ=IJS,IJL
TEMP2(IJ,M) = FRM5(M)
ENDDO
ENDDO
ELSE
DO M=1,NFRE
DO IJ=IJS,IJL
!AR: WAM TABLE REPLACES BY WWM WK AKM1 = 1./TFAK(INDEP(IJ),M)
AKM1 = 1./WK(M,IJ)
!AR: WAM TABLE REPLACES BY WWM CG AK2VGM1 = AKM1**2/TCGOND(INDEP(IJ),M)
AK2VGM1 = AKM1**2/CG(M,IJ)
TEMP2(IJ,M) = AKM1*AK2VGM1
! WRITE(111113,'(4F20.10)') AKM1, AK2VGM1, TEMP2(IJ,M)
ENDDO
ENDDO
ENDIF
DO IJ=IJS,IJL
GADIAG(IJ) = 1./TEMP2(IJ,MIJ(IJ))
IF (LOUTWAM) WRITE(111113,*) 'AFTER MEAN PARAMETER'
IF (LOUTWAM) WRITE(111113,'(I10,5F20.10)') MIJ(IJ), AKMEAN, FMEANWS, TEMP2(IJ,MIJ(IJ)), GADIAG(IJ)
ENDDO
!* 2.5.4 MERGE TAIL INTO SPECTRA.
! ------------------------
DO IJ=IJS,IJL
DO M=1,MIJ(IJ)
FCONST(IJ,M) = 1.
TEMP(IJ,M) = 0.
! WRITE(111113,'(I10,2F15.10)') M, FCONST(IJ,M), TEMP(IJ,M)
ENDDO
DO M=MIJ(IJ)+1,NFRE
FCONST(IJ,M) = 0.
TEMP(IJ,M) = TEMP2(IJ,M)*GADIAG(IJ)
!WRITE(111113,'(I10,3F15.10)')M,FCONST(IJ,M),TEMP(IJ,M),GADIAG(IJ)
ENDDO
ENDDO
DO K=1,NANG
DO IJ=IJS,IJL
GADIAG(IJ) = FL3(IJ,K,MIJ(IJ))
! WRITE(111113,'(I10,10F20.10)') K, FL3(IJ,K,MIJ(IJ))
ENDDO
DO M=1,NFRE
DO IJ=IJS,IJL
!AR: ICE FLLOWEST = FLMINFR(JU(IJ),M)*SPRD(IJ,K)
!AR: ICE FL3(IJ,K,M) = GADIAG(IJ)*TEMP(IJ,M) &
!AR: ICE & + MAX(FL3(IJ,K,M),FLLOWEST)*FCONST(IJ,M)
FL3(IJ,K,M) = GADIAG(IJ)*TEMP(IJ,M) &
& + FL3(IJ,K,M)*FCONST(IJ,M)
! WRITE(111113,'(2I10,10F20.10)')K,M,FL3(IJ,K,M),&
! & TEMP(IJ,M),GADIAG(IJ),FCONST(IJ,M)
ENDDO
ENDDO
ENDDO
DO IJ=IJS,IJL
IF (LOUTWAM) WRITE(111113,*) 'BEFORE WIND INPUT 2'
IF (LOUTWAM) WRITE(111113,'(8F20.10)') SUM(FL3) , SUM(FL), THWNEW(IJ)
IF (LOUTWAM) WRITE(111113,'(8F20.10)') USNEW(IJ), Z0NEW(IJ), ZIDLNEW(IJ)
IF (LOUTWAM) WRITE(111113,'(8F20.10)') SUM(SL), SUM(XLLWS(IJ,:,:))
ENDDO
!* 2.5.5 REEVALUATE WIND INPUT SOURCE TERM, AND WAVE DISSIPATION.
! -------------------------------------------------------
IF(IPHYS.EQ.0) THEN
CALL SINPUT (FL3, FL, IJS, IJL, THWNEW, USNEW, Z0NEW, &
& ROAIRN, ZIDLNEW, SL, XLLWS, SSIN, DSSIN)
ELSE
CALL SINPUT_ARD (FL3, FL, IJS, IJL, THWNEW, USNEW, Z0NEW, &
& ROAIRN, ZIDLNEW, SL, XLLWS, SSIN, DSSDS)
ENDIF
IF (LOUTWAM) WRITE(111113,*) 'AFTER SINPUT 2'
IF (LOUTWAM) WRITE(111113,'(I10,10F15.7)') IJS, SUM(FL), SUM(SL)
IF (ITEST.GE.2) THEN
WRITE(IU06,*) ' SUB. IMPLSCH: SINPUT CALLED AT THE END'
CALL FLUSH (IU06)
ENDIF
CALL STRESSO (FL3, IJS, IJL, THWNEW, USNEW, Z0NEW, &
& ROAIRN, TAUW, TAUWLF, PHIWA, &
& PHIAWDIAG, PHIAWUNR, SL, MIJ, &
& LCFLX)
IF (LOUTWAM) WRITE(111113,*) 'AFTER STRESSO 2'
IF (LOUTWAM) WRITE(111113,'(I10,15F15.7)') IJS, IJL, SUM(FL3), &
& THWNEW, USNEW, Z0NEW, &
& ROAIRN, TAUW, TAUWLF, PHIWA, &
& PHIAWDIAG, PHIAWUNR, SUM(SL), &
& MIJ
IF (ITEST.GE.2) THEN
WRITE(IU06,*) ' SUB. IMPLSCH: STRESSO CALLED AT THE END'
CALL FLUSH (IU06)
ENDIF
CALL AIRSEA (U10NEW(IJS), TAUW(IJS), USNEW(IJS), Z0NEW(IJS), &
& IJS, IJL, ILEV)
IF (ITEST.GE.2) THEN
WRITE(IU06,*) ' SUB. IMPLSCH: AIRSEA CALLED AT THE END'
CALL FLUSH (IU06)
ENDIF
IF (LOUTWAM) WRITE(111113,*) 'AFTER AIRSEA 3'
IF (LOUTWAM) WRITE(111113,'(I10,10F15.7)') IJS, U10NEW(IJS), TAUW(IJS), &
& USNEW(IJS), Z0NEW(IJS), ILEV
IF(IPHYS.EQ.0) THEN
CALL SDISSIP (FL3 ,FL, IJS, IJL, IG, SL, F1MEAN, XKMEAN, &
& PHIOC, TAUWD, MIJ, SSDS, DSSDS)
ELSE
CALL SDISS_ARDH_VEC (FL3 ,FL, IJS, IJL, SL, F1MEAN, XKMEAN, &
& PHIOC, TAUWD, MIJ, SSDS, DSSDS)
ENDIF
IF (LOUTWAM) WRITE(111113,*) 'AFTER DISSIP'
IF (LOUTWAM) WRITE(111113,'(I10,10F15.7)') IJS, SUM(FL), SUM(FL3), SUM(SL)
IF (ITEST.GE.2) THEN
WRITE(IU06,*) ' SUB. IMPLSCH: SDISSIP CALLED AT THE END'
CALL FLUSH (IU06)
ENDIF
!* 2.5.6 DETERMINE FLUXES FROM AIR TO WAVE AND FROM WAVE TO OCEAN.
! -------------------------------------------------------
IF(LCFLX) THEN
DO IJ=IJS,IJL
TAU = ROAIRN(IJ)*USNEW(IJ)**2
XN = ROAIRN(IJ)*USNEW(IJ)**3
PHIDIAG = PHIAWDIAG(IJ)+PHIAWUNR(IJ)
PHIEPS(IJ) = (PHIOC(IJ)-PHIDIAG)/XN
PHIAW(IJ) = (PHIWA(IJ)+PHIAWUNR(IJ))/XN
TAUOC(IJ) = (TAU-TAUWLF(IJ)-TAUWD(IJ))/TAU
ENDDO
ENDIF
! ----------------------------------------------------------------------
!* 2.6 SAVE WINDS INTO INTERMEDIATE STORAGE.
! -------------------------------------
DO IJ=IJS,IJL
USOLD(IJ) = USNEW(IJ)
Z0OLD(IJ) = Z0NEW(IJ)
ROAIRO(IJ) = ROAIRN(IJ)
ZIDLOLD(IJ) = ZIDLNEW(IJ)
ENDDO
DO IJ=IJS,IJL
UFRIC(IJ) = USNEW(IJ)
Z0(IJ) = Z0NEW(IJ)
CD(IJ) = (USNEW(IJ)/U10NEW(IJ))**2
ALPHA_CH(IJ) = G*Z0NEW(IJ)/USNEW(IJ)**2
ENDDO
! ----------------------------------------------------------------------
!IF (LHOOK) CALL DR_HOOK('IMPLSCH',1,ZHOOK_HANDLE)
RETURN
END SUBROUTINE IMPLSCH