Skip to content
Snippets Groups Projects
spawn_model2.f90 50.4 KiB
Newer Older
!
!* vertical interpolation
!
IF (ANY(XZS(:,:)>0.) .AND. (NDXRATIO/=1 .OR. NDYRATIO/=1) )  THEN
  CALL VER_INTERP_FIELD (CTURB,NRR,NSV,ZZZ_LS,XZZ,                             &
               XUT,XVT,XWT,ZTHVT,XRT,ZHUT,XTKET,XSVT,                          &
               XSRCT,XSIGS,                                                    &
               XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM                                 )
ENDIF
!
CALL SECOND_MNH(ZTIME2)
!
ZVER = ZTIME2 - ZTIME1
!
!*       5.7    Absolute pressure :
!
ZTIME1 = ZTIME2
!
CALL SPAWN_PRESSURE2(NXOR,NYOR,NXEND,NYEND,NDXRATIO,NDYRATIO,   &
                     ZZZ_LS,XZZ,ZTHVT,XPABST                    )
!
IF (.NOT.GNOSON) THEN
  ALLOCATE(ZWORK3D(IIUSON,IJUSON,IKU))
  CALL FMREAD(HSONFILE,'PABST',CLUOUT,'XY',ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
  XPABST(IIB2:IIE2,IJB2:IJE2,:) = ZWORK3D(IIB1:IIE1,IJB1:IJE1,:)
  DEALLOCATE(ZWORK3D)
END IF
!
IF (NVERB>=2) THEN
   ALLOCATE(IJCOUNT(IIU,IJU))
   IK4000 = COUNT(XZHAT(:)<4000.)
   IJCOUNT(IIB:IIE,IJB:IJE) = COUNT((ZHUT(IIB:IIE,IJB:IJE,JPVEXT+1:IKE)         &
                              >=MAXVAL(ZHUT(IIB:IIE,IJB:IJE,JPVEXT+1:IKE))-0.01),DIM=3 )
   IIJ = MAXLOC( SUM(ZHUT(IIB:IIE,IJB:IJE,JPVEXT+1:IK4000),3),                  &
        MASK= (  IJCOUNT(IIB:IIE,IJB:IJE) >=1 )                     )           &
        + JPHEXT
  WRITE(ILUOUT,*) ' '
  WRITE(ILUOUT,*) 'humidity     (I=',IIJ(1),';J=',IIJ(2),')'
  DO JK=IKB,IKE
    WRITE(ILUOUT,'(F6.2,2H %)') ZHUT(IIJ(1),IIJ(2),JK)
  END DO
END IF
!*       5.8    Retrieve model thermodynamical variables :
!
ALLOCATE(ZSUMRT(IIU,IJU,IKU))
ZSUMRT(:,:,:) = 0.
IF (NRR==0) THEN
  XTHT(:,:,:) = ZTHVT(:,:,:)
ELSE
  IF (NDXRATIO/=1 .OR. NDYRATIO/=1) THEN
    XRT(:,:,:,1) = SM_PMR_HU(CLUOUT,XPABST(:,:,:),                          &
                             ZTHVT(:,:,:)*(XPABST(:,:,:)/XP00)**(XRD/XCPD), &
                             ZHUT(:,:,:),XRT(:,:,:,:),KITERMAX=100          )
  END IF
  !
  DO JRR=1,NRR
    ZSUMRT(:,:,:) = ZSUMRT(:,:,:) + XRT(:,:,:,JRR)
  END DO
  XTHT(:,:,:) = ZTHVT(:,:,:)/(1.+XRV/XRD*XRT(:,:,:,1))*(1.+ZSUMRT(:,:,:))
END IF
!
DEALLOCATE (ZHUT)
!
CALL SECOND_MNH(ZTIME2)
ZPRESSURE2=ZTIME2-ZTIME1
!
!*       5.9   Large Scale field for lbc treatment:
!
!
!*       5.9.1  U variable
!
!
!
XLBXUM(1:NRIMX+JPHEXT,:,:)         = XUT(2:NRIMX+JPHEXT+1,:,:)
XLBXUM(NRIMX+JPHEXT+1:2*NRIMX+2*JPHEXT,:,:) = XUT(IIE+1-NRIMX:IIE+JPHEXT,:,:)
IF( .NOT. L2D ) THEN
  XLBYUM(:,1:NRIMY+JPHEXT,:)         = XUT(:,1:NRIMY+JPHEXT,:)
  XLBYUM(:,NRIMY+JPHEXT+1:2*NRIMY+2*JPHEXT,:) = XUT(:,IJE+1-NRIMY:IJE+JPHEXT,:)
END IF
!
!*       5.9.2  V variable
!
!
XLBXVM(1:NRIMX+JPHEXT,:,:)         = XVT(1:NRIMX+JPHEXT,:,:)
XLBXVM(NRIMX+JPHEXT+1:2*NRIMX+2*JPHEXT,:,:) = XVT(IIE+1-NRIMX:IIE+JPHEXT,:,:)
IF( .NOT. L2D ) THEN
  XLBYVM(:,1:NRIMY+JPHEXT,:)         = XVT(:,2:NRIMY+JPHEXT+1,:)
  XLBYVM(:,NRIMY+JPHEXT+1:2*NRIMY+2*JPHEXT,:) = XVT(:,IJE+1-NRIMY:IJE+JPHEXT,:)
END IF
!
!*       5.9.3  W variable
!
!
XLBXWM(1:NRIMX+JPHEXT,:,:)         = XWT(1:NRIMX+JPHEXT,:,:)
XLBXWM(NRIMX+JPHEXT+1:2*NRIMX+2*JPHEXT,:,:) = XWT(IIE+1-NRIMX:IIE+JPHEXT,:,:)
IF( .NOT. L2D ) THEN
  XLBYWM(:,1:NRIMY+JPHEXT,:)         = XWT(:,1:NRIMY+JPHEXT,:)
  XLBYWM(:,NRIMY+JPHEXT+1:2*NRIMY+2*JPHEXT,:) = XWT(:,IJE+1-NRIMY:IJE+JPHEXT,:)
END IF
!
!*       5.9.4  TH variable
!
!
XLBXTHM(1:NRIMX+JPHEXT,:,:)         = XTHT(1:NRIMX+JPHEXT,:,:)
XLBXTHM(NRIMX+JPHEXT+1:2*NRIMX+2*JPHEXT,:,:) = XTHT(IIE+1-NRIMX:IIE+JPHEXT,:,:)
IF( .NOT. L2D ) THEN
  XLBYTHM(:,1:NRIMY+JPHEXT,:)         = XTHT(:,1:NRIMY+JPHEXT,:)
  XLBYTHM(:,NRIMY+JPHEXT+1:2*NRIMY+2*JPHEXT,:) = XTHT(:,IJE+1-NRIMY:IJE+JPHEXT,:)
END IF
!
!*       5.9.5  TKE variable
!
!
IF (HTURB /= 'NONE') THEN
  XLBXTKEM(1:NRIMX+JPHEXT,:,:)         = XTKET(1:NRIMX+JPHEXT,:,:)
  XLBXTKEM(NRIMX+JPHEXT+1:2*NRIMX+2*JPHEXT,:,:) = XTKET(IIE+1-NRIMX:IIE+JPHEXT,:,:)
  IF( .NOT. L2D ) THEN
    XLBYTKEM(:,1:NRIMY+JPHEXT,:)         = XTKET(:,1:NRIMY+JPHEXT,:)
    XLBYTKEM(:,NRIMY+JPHEXT+1:2*NRIMY+2*JPHEXT,:) = XTKET(:,IJE+1-NRIMY:IJE+JPHEXT,:)
  END IF
ENDIF
! 
!
!*       5.9.6  moist variables
!
IF (NRR >= 1) THEN
  DO JRR =1,NRR  
    XLBXRM(1:NRIMX+JPHEXT,:,:,JRR)         = XRT(1:NRIMX+JPHEXT,:,:,JRR)
    XLBXRM(NRIMX+JPHEXT+1:2*NRIMX+2*JPHEXT,:,:,JRR) = XRT(IIE+1-NRIMX:IIE+JPHEXT,:,:,JRR)
    IF( .NOT. L2D ) THEN
      XLBYRM(:,1:NRIMY+JPHEXT,:,JRR)         = XRT(:,1:NRIMY+JPHEXT,:,JRR)
      XLBYRM(:,NRIMY+JPHEXT+1:2*NRIMY+2*JPHEXT,:,JRR) = XRT(:,IJE+1-NRIMY:IJE+JPHEXT,:,JRR)
    END IF
  END DO
END IF
!
!*       5.9.7  scalar variables
!
IF (NSV /= 0) THEN
  DO JSV = 1, NSV
    XLBXSVM(1:NRIMX+JPHEXT,:,:,JSV)         = XSVT(1:NRIMX+JPHEXT,:,:,JSV)
    XLBXSVM(NRIMX+JPHEXT+1:2*NRIMX+2*JPHEXT,:,:,JSV) = XSVT(IIE+1-NRIMX:IIE+JPHEXT,:,:,JSV)
    IF( .NOT. L2D ) THEN
      XLBYSVM(:,1:NRIMY+JPHEXT,:,JSV)         = XSVT(:,1:NRIMY+JPHEXT,:,JSV)
      XLBYSVM(:,NRIMY+JPHEXT+1:2*NRIMY+2*JPHEXT,:,JSV) = XSVT(:,IJE+1-NRIMY:IJE+JPHEXT,:,JSV)
    END IF
  END DO
ENDIF
!
!*       5.10 Surface precipitation computation
!
IF (SIZE(XINPRR) /= 0 ) THEN
  IF (GNOSON) &
    CALL SPAWN_SURF2_RAIN (NXOR,NYOR,NXEND,NYEND,NDXRATIO,NDYRATIO,   &
              XINPRC,XACPRC,XINPRR,XINPRR3D,XEVAP3D,                  &
              XACPRR,XINPRS,XACPRS,XINPRG,XACPRG,&
              XINPRH,XACPRH )
  IF (.NOT.GNOSON) &
    CALL SPAWN_SURF2_RAIN (NXOR,NYOR,NXEND,NYEND,NDXRATIO,NDYRATIO,  &
           XINPRC,XACPRC,XINPRR,XINPRR3D,XEVAP3D,                    &
           XACPRR,XINPRS,XACPRS,XINPRG,XACPRG,XINPRH,XACPRH,         &
           HSONFILE,IIUSON,IJUSON,                                   &
           IIB2,IJB2,IIE2,IJE2,                                      &
           IIB1,IJB1,IIE1,IJE1                                       )
ENDIF
!
!*       5.11   Total mass of dry air Md computation :
!
ZTIME1 = ZTIME2
!
ALLOCATE(ZRHOD(IIU,IJU,IKU))
ZRHOD(:,:,:)=XPABST(:,:,:)/(XPABST(:,:,:)/XP00)**(XRD/XCPD) &
            /(XRD*ZTHVT(:,:,:)*(1.+ZSUMRT(:,:,:)))
!
CALL TOTAL_DMASS(CLUOUT,ZJ,ZRHOD,XDRYMASST)
!
DEALLOCATE (ZRHOD)
DEALLOCATE (ZSUMRT,ZTHVT)
!
CALL SECOND_MNH(ZTIME2)
!
ZMISC = ZMISC + ZTIME2 - ZTIME1
!
!*       5.12 Deallocation of model 1 variables : 
!
ZTIME1 = ZTIME2
!
CALL DEALLOCATE_MODEL1(3)
!
CALL SECOND_MNH(ZTIME2)
!
ZMISC = ZMISC + ZTIME2 - ZTIME1
!
!*       5.13 Anelastic correction : 
!
CALL SECOND_MNH(ZTIME1)
!
IF (.NOT. L1D) THEN
  CALL ANEL_BALANCE_n
  CALL BOUNDARIES (                                                 &
            0.,CLBCX,CLBCY,NRR,NSV,1,                               &
            XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM,XLBXRM,XLBXSVM,   &
            XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM,   &
            XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM,XLBXRM,XLBXSVM,   &
            XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM,   &
            XRHODJ,                                                 &
            XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, XSRCT            )
END IF
!
CALL SECOND_MNH(ZTIME2)
!
ZANEL = ZTIME2 - ZTIME1
!
!
!
!-------------------------------------------------------------------------------
!
!*	 6.    WRITE THE FMFILE
!	       ---------------- 
!
CALL SECOND_MNH(ZTIME1)
!
INPRAR = 22 + 2*(4+NRR+NSV) ! 22 = number of grid variables + reference state
                            ! variables +dimension variables
                            ! 2*(4+NRR+NSV) = number of prognostic variables
                            ! at time t and t-dt
ITYPE=1
!
IF ( ( LEN_TRIM(HSPAFILE) /= 0 ) .AND. ( ADJUSTL(HSPAFILE) /= ADJUSTL(CINIFILE) ) ) THEN
  CMY_NAME(2)=HSPAFILE
ELSE
  CMY_NAME(2)=ADJUSTL(ADJUSTR(CINIFILE)//'.spa'//ADJUSTL(HSPANBR))
  IF (.NOT.GNOSON)   &
     CMY_NAME(2)=ADJUSTL(ADJUSTR(CINIFILE)//'.spr'//ADJUSTL(HSPANBR))
END IF
!
CALL FMOPEN_ll(CMY_NAME(2),'WRITE',CLUOUT,INPRAR,ITYPE,NVERB,ININAR,IRESP)
!
YDESFM=ADJUSTL(ADJUSTR(CMY_NAME(2))//'.des')
!
CALL WRITE_DESFM_n(2,YDESFM,CLUOUT)
!
IF (LBAL_ONLY) THEN  ! same relation with its DAD for model2 and for model1
  NDXRATIO_ALL(2) = NDXRATIO_ALL(1)
  NDYRATIO_ALL(2) = NDYRATIO_ALL(1)
  NXOR_ALL(2)     = NXOR_ALL(1)
  NYOR_ALL(2)     = NYOR_ALL(1)
  NXEND_ALL(2)    = NXEND_ALL(1)
  NYEND_ALL(2)    = NYEND_ALL(1)
  CDAD_NAME(2)    = CDAD_NAME(1)
  IF (CDADSPAFILE == '' ) THEN
    IF (NDXRATIO_ALL(1) == 1 .AND. NDYRATIO_ALL(1) == 1 &
      .AND. NXOR_ALL(1) == 1 .AND. NYOR_ALL(1) == 1 ) THEN
      ! for spawning with ratio=1 
      ! if the DAD of model 1 is itself, the DAD of model 2 also.
      CDAD_NAME(2)=CMY_NAME(2)
    ENDIF
  ENDIF
  ! case of model with DAD
  IF (CDADSPAFILE /='') CDAD_NAME(2)=CDADSPAFILE
ELSE
  CDAD_NAME(2)=CMY_NAME(1) ! model 1 becomes the DAD of model 2 (spawned one)
ENDIF
!
#ifdef MNH_NCWRIT
NC_WRITE = LNETCDF
CALL WRITE_LFIFM_n(CMY_NAME(2),CDAD_NAME(2))
IF ( LNETCDF ) THEN
  DEF_NC=.FALSE.
  CALL WRITE_LFIFM_n(CMY_NAME(2),CDAD_NAME(2))
  DEF_NC=.TRUE.
END IF
#else
CALL WRITE_LFIFM_n(CMY_NAME(2),CDAD_NAME(2))
#endif
!
CALL SECOND_MNH(ZTIME2)
!
ZWRITE = ZTIME2 - ZTIME1
!
!-------------------------------------------------------------------------------
!
!*       7.      Surface variables :
!
ZTIME1 = ZTIME2
!
CALL SPAWN_SURF(HINIFILE,HINIFILEPGD,OSPAWN_SURF)
!
CALL SECOND_MNH(ZTIME2)
!
ZSURF2 = ZTIME2 - ZTIME1
!
!-------------------------------------------------------------------------------
!
!*	 8.    CLOSES THE FMFILE
!	       ----------------- 
!
CALL FMCLOS_ll(CMY_NAME(2),'KEEP',CLUOUT,IRESP)
IF (LEN_TRIM(HSONFILE) /= 0 ) THEN
  CALL FMCLOS_ll(HSONFILE,'KEEP',CLUOUT,IRESP)
END IF
!
!-------------------------------------------------------------------------------
!
!*       9.    PRINTS ON OUTPUT-LISTING
!              ------------------------
!
WRITE(ILUOUT,FMT=9900) XZHAT(1)
!
DO JLOOP = 2,IKU
 WRITE(ILUOUT,FMT=9901) JLOOP,XZHAT(JLOOP),XZHAT(JLOOP)-XZHAT(JLOOP-1)
END DO
!
IF (NVERB >= 5) THEN
  WRITE(ILUOUT,*) 'SPAWN_MODEL2: LUSERV,LUSERC=',LUSERV,LUSERC 
  WRITE(ILUOUT,*) 'SPAWN_MODEL2: LUSERR,LUSERI,LUSERS=',LUSERR,LUSERI,LUSERS
  WRITE(ILUOUT,*) 'SPAWN_MODEL2: LUSERG,LUSERH,NSV=',LUSERG,LUSERH,NSV
  WRITE(ILUOUT,*) 'SPAWN_MODEL2: NRR=',NRR
  WRITE(ILUOUT,*) 'SPAWN_MODEL2: NVERB=',NVERB
  WRITE(ILUOUT,*) 'SPAWN_MODEL2: XLON0,XLAT0,XBETA=',XLON0,XLAT0,XBETA
  WRITE(ILUOUT,*) 'SPAWN_MODEL2: LCARTESIAN=',LCARTESIAN
  IF(LCARTESIAN) THEN
    WRITE(ILUOUT,*) 'SPAWN_MODEL2: No map projection used.'
  ELSE
    WRITE(ILUOUT,*) 'SPAWN_MODEL2: XRPK,XLONORI,XLATORI=',XRPK,XLONORI,XLATORI
    IF (ABS(XRPK) == 1.) THEN
      WRITE(ILUOUT,*) 'SPAWN_MODEL2: Polar stereo used.'
    ELSE IF (XRPK == 0.) THEN
      WRITE(ILUOUT,*) 'SPAWN_MODEL2: Mercator used.'
    ELSE
      WRITE(ILUOUT,*) 'SPAWN_MODEL2: Lambert used, cone factor=',XRPK 
    END IF
  END IF
END IF
!
IF (NVERB >= 10) THEN
  WRITE(ILUOUT,*) 'SPAWN_MODEL2: IIB, IJB, IKB=',IIB,IJB,IKB
  WRITE(ILUOUT,*) 'SPAWN_MODEL2: IIU, IJU, IKU=',IIU,IJU,IKU
END IF
!
IF(NVERB >= 10) THEN                               !Value control
  WRITE(ILUOUT,*) 'SPAWN_MODEL2: Some XZS values:'
  WRITE(ILUOUT,*) XZS(1,IJU),XZS((IIU-1)/2,IJU),XZS(IIU,IJU)  
  WRITE(ILUOUT,*) XZS(1,(IJU-1)/2),XZS((IIU-1)/2,(IJU-1)/2),XZS(IIU,(IJU-1)/2)  
  WRITE(ILUOUT,*) XZS(1,1)      ,XZS((IIU-1)/2,1)      ,XZS(IIU,1)  
END IF
!
IF(NVERB >= 10) THEN       !Value control
  WRITE(ILUOUT,*) 'SPAWN_MODEL2: Some XUT values:'
  WRITE(ILUOUT,*) ' (1,IJU/2,JK) (IIU/2,1,JK) (IIU/2,IJU/2,JK) &
                   &(IIU/2,IJU,JK) (IIU,IJU/2,JK)'
  DO JKLOOP=1,IKU
    WRITE(ILUOUT,*) 'JK = ',JKLOOP
    WRITE(ILUOUT,*) XUT(1,IJU/2,JKLOOP),XUT(IIU/2,1,JKLOOP),       &
                    XUT(IIU/2,IJU/2,JKLOOP),XUT(IIU/2,IJU,JKLOOP), &
                    XUT(IIU,IJU/2,JKLOOP)
  END DO
  WRITE(ILUOUT,*) 'SPAWN_MODEL2: Some XVT values:'
  WRITE(ILUOUT,*) ' (1,IJU/2,JK) (IIU/2,1,JK) (IIU/2,IJU/2,JK) &
                   &(IIU/2,IJU,JK) (IIU,IJU/2,JK)'
  DO JKLOOP=1,IKU
    WRITE(ILUOUT,*) 'JK = ',JKLOOP
    WRITE(ILUOUT,*) XVT(1,IJU/2,JKLOOP),XVT(IIU/2,1,JKLOOP),       &
                    XVT(IIU/2,IJU/2,JKLOOP),XVT(IIU/2,IJU,JKLOOP), &
                    XVT(IIU,IJU/2,JKLOOP)
  END DO
  WRITE(ILUOUT,*) 'SPAWN_MODEL2: Some XWT values:'
  WRITE(ILUOUT,*) ' (1,IJU/2,JK) (IIU/2,1,JK) (IIU/2,IJU/2,JK) &
                   &(IIU/2,IJU,JK) (IIU,IJU/2,JK)'
  DO JKLOOP=1,IKU
    WRITE(ILUOUT,*) 'JK = ',JKLOOP
    WRITE(ILUOUT,*) XWT(1,IJU/2,JKLOOP),XWT(IIU/2,1,JKLOOP),       &
                    XWT(IIU/2,IJU/2,JKLOOP),XWT(IIU/2,IJU,JKLOOP), &
                    XWT(IIU,IJU/2,JKLOOP)
  END DO
  WRITE(ILUOUT,*) 'SPAWN_MODEL2: Some XTHT values:'
  WRITE(ILUOUT,*) ' (1,IJU/2,JK) (IIU/2,1,JK) (IIU/2,IJU/2,JK) &
                   &(IIU/2,IJU,JK) (IIU,IJU/2,JK)'
  DO JKLOOP=1,IKU
    WRITE(ILUOUT,*) 'JK = ',JKLOOP
    WRITE(ILUOUT,*) XTHT(1,IJU/2,JKLOOP),XTHT(IIU/2,1,JKLOOP),       &
                    XTHT(IIU/2,IJU/2,JKLOOP),XTHT(IIU/2,IJU,JKLOOP), &
                    XTHT(IIU,IJU/2,JKLOOP)
  END DO
  IF(NRR >= 1) THEN
    WRITE(ILUOUT,*) 'SPAWN_MODEL2: Some XRT values:'
    WRITE(ILUOUT,*) ' (1,IJU/2,JK) (IIU/2,1,JK) (IIU/2,IJU/2,JK) &
                     &(IIU/2,IJU,JK) (IIU,IJU/2,JK)'
    DO JKLOOP=1,IKU
      WRITE(ILUOUT,*) 'JK = ',JKLOOP
      WRITE(ILUOUT,*) XRT(1,IJU/2,JKLOOP,1),XRT(IIU/2,1,JKLOOP,1),       &
                      XRT(IIU/2,IJU/2,JKLOOP,1),XRT(IIU/2,IJU,JKLOOP,1), &
                      XRT(IIU,IJU/2,JKLOOP,1)
    END DO
  END IF
  !
  IF (LUV_FLX) THEN
    WRITE(ILUOUT,*)'SPAWN_MODEL2: Some EDDY_FLUX values XVU_FLUX(IIU/2,2,:)=',XVU_FLUX_M(IIU/2,2,:)
  END IF
  !
  IF (LTH_FLX) THEN
    WRITE(ILUOUT,*)'SPAWN_MODEL2: Some EDDY_FLUX values XVTH_FLUX(IIU/2,2,:)=',XVTH_FLUX_M(IIU/2,2,:)
    WRITE(ILUOUT,*)'SPAWN_MODEL2: Some EDDY_FLUX values XWTH_FLUX(IIU/2,2,:)=',XWTH_FLUX_M(IIU/2,2,:)
  END IF
  !
END IF
!
WRITE(ILUOUT,*) 'SPAWN_MODEL2: SPAWN_MODEL2 ENDS CORRECTLY.'
!
CALL SECOND_MNH (ZEND)
!
ZTOT        = ZEND - ZSTART          ! for computing time analysis
!
ZALL = ZGRID2 + ZSURF2 + ZMISC + ZFIELD2 + ZVER + ZPRESSURE2 + ZANEL + ZWRITE
!
ZPERCALL  = 100.*ZALL/ZTOT
!
ZPERCGRID2  = 100.*ZGRID2/ZTOT
ZPERCSURF2  = 100.*ZSURF2/ZTOT
ZPERCMISC   = 100.*ZMISC/ZTOT
ZPERCFIELD2 = 100.*ZFIELD2/ZTOT
ZPERCVER    = 100.*ZVER/ZTOT
ZPERCPRESSURE2 = 100.*ZPRESSURE2/ZTOT
ZPERCANEL   = 100.*ZANEL/ZTOT
ZPERCWRITE  = 100.*ZWRITE/ZTOT
!
WRITE(ILUOUT,*)
WRITE(ILUOUT,*) ' ------------------------------------------------------------ '
WRITE(ILUOUT,*) '|                                                            |'
WRITE(ILUOUT,*) '|           COMPUTING TIME ANALYSIS in SPAWN_MODEL2          |'
WRITE(ILUOUT,*) '|                                                            |'
WRITE(ILUOUT,*) '|------------------------------------------------------------|'
WRITE(ILUOUT,*) '|                     |                   |                  |'
WRITE(ILUOUT,*) '|    ROUTINE NAME     |     CPU-TIME      |   PERCENTAGE %   |'
WRITE(ILUOUT,*) '|                     |                   |                  |'
WRITE(ILUOUT,*) '|---------------------|-------------------|------------------|'
WRITE(ILUOUT,*) '|                     |                   |                  |'
WRITE(UNIT=ILUOUT,FMT=1) ZGRID2 ,ZPERCGRID2
WRITE(UNIT=ILUOUT,FMT=3) ZFIELD2,ZPERCFIELD2
WRITE(UNIT=ILUOUT,FMT=8) ZVER,ZPERCVER
WRITE(UNIT=ILUOUT,FMT=7) ZPRESSURE2,ZPERCPRESSURE2
WRITE(UNIT=ILUOUT,FMT=2) ZSURF2 ,ZPERCSURF2
WRITE(UNIT=ILUOUT,FMT=4) ZANEL  ,ZPERCANEL
WRITE(UNIT=ILUOUT,FMT=5) ZWRITE ,ZPERCWRITE
WRITE(UNIT=ILUOUT,FMT=9) ZMISC  ,ZPERCMISC
WRITE(UNIT=ILUOUT,FMT=6) ZTOT   ,ZPERCALL
WRITE(ILUOUT,*) ' ------------------------------------------------------------ '
!
!                  FORMATS
!                  -------
!
1  FORMAT(' |    SPAWN_GRID2      |     ',F8.3,'      |     ',F8.3,'     |')
3  FORMAT(' |    SPAWN_FIELD2     |     ',F8.3,'      |     ',F8.3,'     |')
8  FORMAT(' |  VER_INTERP_FIELD   |     ',F8.3,'      |     ',F8.3,'     |')
7  FORMAT(' |  SPAWN_PRESSURE2    |     ',F8.3,'      |     ',F8.3,'     |')
2  FORMAT(' |    SPAWN_SURF2      |     ',F8.3,'      |     ',F8.3,'     |')
4  FORMAT(' |   ANEL_BALANCE2     |     ',F8.3,'      |     ',F8.3,'     |')
5  FORMAT(' |      WRITE          |     ',F8.3,'      |     ',F8.3,'     |')
9  FORMAT(' |   MISCELLANEOUS     |     ',F8.3,'      |     ',F8.3,'     |')
6  FORMAT(' |    SPAWN_MODEL2     |     ',F8.3,'      |     ',F8.3,'     |')
!
!
CALL CLOSE_ll(CLUOUT,IOSTAT=IRESP)
!
9900  FORMAT(' K = 001    ZHAT = ',E14.7)
9901  FORMAT(' K = ',I3.3,'    ZHAT = ',E14.7,'    DZ = ' ,E14.7)
!
!-------------------------------------------------------------------------------
!
!
! Switch back to model index of calling routine
CALL GOTO_MODEL(IMI)
!
END SUBROUTINE SPAWN_MODEL2