cvsp_write_profile.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\sisyphe\cvsp_write_profile.f
00002 !
00093                         SUBROUTINE CVSP_WRITE_PROFILE
00094 !                       *****************************
00095 !
00096 !***********************************************************************
00097 ! SISYPHE   V6P3                                   14/04/2013
00098 !***********************************************************************
00099 !
00100 !
00101 !
00102 !
00103 !
00104 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00105 !| -              |---|
00106 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00107 !
00108       USE BIEF
00109       USE CVSP_OUTPUTFILES
00110       USE DECLARATIONS_SISYPHE
00111 !
00112       IMPLICIT NONE
00113       INTEGER LNG,LU
00114       COMMON/INFO/LNG,LU
00115 !
00116 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00117 !
00118       INTEGER I,J,K
00119       DOUBLE PRECISION BSUM, SUMERR, AT
00120 !
00121 !-----------------------------------------------------------------------
00122 !
00123       WRITE(LU,*) 'CVSP_WRITE_PROFILE ON CPU ', IPID
00124 !
00125 !-----------------------------------------------------------------------
00126 ! CHOOSE WHAT YOU WANT TO HAVE IN VSPRES
00127 ! NUMBER OF PRINTOUT VARIABLES
00128 !-----------------------------------------------------------------------
00129 !
00130       URBLOC%N = 3 + NSICLA       ! NUMVARUR3D2RES
00131 !
00132       AT = DT*LT/PERCOU
00133 !
00134       DO I= 0, PRO_MAX_MAX-1
00135         DO J= 1, NPOIN         ! D50
00136           BSUM = 0.D0
00137           SUMERR = 1.D0
00138           DO K=1,NSICLA
00139             BSUM = FDM(K)*PRO_F(J,I+1,K) + BSUM
00140             SUMERR = SUMERR - PRO_F(J,I+1,K)
00141           ENDDO
00142           IF ((I+1).LE.PRO_MAX(J)) THEN
00143             VSP_ERROR%R(J+I*NPOIN) = SUMERR
00144             VSP_D50%R(J+I*NPOIN) = BSUM
00145             VSP_D%R(J+I*NPOIN) = PRO_D(J,I+1,1)
00146           ELSE
00147             VSP_ERROR%R(J+I*NPOIN) = VSP_ERROR%R(J+(I-1)*NPOIN)
00148             VSP_D50%R(J+I*NPOIN)   = VSP_D50%R(J+(I-1)*NPOIN)
00149             VSP_D%R(J+I*NPOIN)     = VSP_D%R(J+(I-1)*NPOIN)
00150           ENDIF
00151           DO K= 1, NSICLA
00152             IF ((I+1).LE.PRO_MAX(J)) THEN
00153               VSP_FRA(K)%R(J+I*NPOIN) = PRO_F(J,I+1,K)
00154             ELSE
00155               VSP_FRA(K)%R(J+I*NPOIN) = PRO_F(J,PRO_MAX(J),K)
00156             ENDIF
00157           ENDDO
00158         ENDDO
00159       ENDDO
00160 !
00161 !-----------------------------------------------------------------------
00162 ! CHOOSE WHAT YOU WANT TO HAVE IN 2DHYD_AS_3D
00163 ! NUMBER OF PRINTOUT VARIABLES
00164 !-----------------------------------------------------------------------
00165 !
00166       URBLOC2DHYD%N = NUMVAR2DHYD
00167 !
00168       DO J= 1, NPOIN
00169         UR2DHYD(1)%R(J) = ZF%R(J)
00170         UR2DHYD(1)%R(J+NPOIN) = Z%R(J)
00171 !
00172         UR2DHYD(2)%R(J) = U2D%R(J)
00173         UR2DHYD(2)%R(J+NPOIN) = UR2DHYD(2)%R(J)
00174 !
00175         UR2DHYD(3)%R(J) = V2D%R(J)
00176         UR2DHYD(3)%R(J+NPOIN) = UR2DHYD(3)%R(J)
00177 !
00178         UR2DHYD(4)%R(J) = 0.D0
00179         UR2DHYD(4)%R(J+NPOIN) = UR2DHYD(4)%R(J)
00180 !
00181         UR2DHYD(5)%R(J) = (U2D%R(J)**2.D0 + V2D%R(J)**2.D0)**0.5D0
00182         UR2DHYD(5)%R(J+NPOIN) = UR2DHYD(5)%R(J)
00183 !
00184         UR2DHYD(6)%R(J) = TOB%R(J)
00185         UR2DHYD(6)%R(J+NPOIN) = 0.D0
00186       ENDDO
00187 !
00188 !-----------------------------------------------------------------------
00189 ! POINT TO BIEF OBJECTS THAT WILL BE PRINTED TO
00190 ! MAKE YOUR OWN DECISSION HERE
00191 !-----------------------------------------------------------------------
00192 !
00193       URBLOC3D%ADR(1)%P => VSP_D
00194       URBLOC3D%ADR(2)%P => VSP_D50
00195       URBLOC3D%ADR(3)%P => VSP_ERROR
00196       DO K = 1, NSICLA
00197         URBLOC3D%ADR(3+K)%P => VSP_FRA(K)
00198       ENDDO
00199 !
00200 !-----------------------------------------------------------------------
00201 ! POINT TO BIEF OBJECTS THAT WILL BE PRINTED TO 2DHYD_AS_3D FILE
00202 ! MAKE YOUR OWN DECISSION HERE
00203 !-----------------------------------------------------------------------
00204 !
00205       URBLOC2DHYD%ADR(1)%P => UR2DHYD(1)
00206       URBLOC2DHYD%ADR(2)%P => UR2DHYD(2)
00207       URBLOC2DHYD%ADR(3)%P => UR2DHYD(3)
00208       URBLOC2DHYD%ADR(4)%P => UR2DHYD(4)
00209       URBLOC2DHYD%ADR(5)%P => UR2DHYD(5)
00210       URBLOC2DHYD%ADR(6)%P => UR2DHYD(6)
00211 !
00212       USERPRINTCOUNT = USERPRINTCOUNT + 1
00213 !
00214 !-----------------------------------------------------------------------
00215 ! ADD THIS TO TIME BECAUSE TECPLOT DOESN'T SUPPORT MULTIPLE TIME STAMPS IN ONE FILE.
00216 !-----------------------------------------------------------------------
00217 !
00218       USERTIME= AT + USERPRINTCOUNT / 1.0D5
00219 !
00220 !-----------------------------------------------------------------------
00221 ! WRITE TIME STEP TO    !VSP
00222 !-----------------------------------------------------------------------
00223 !
00224       SELECT CASE (CP_FILES(3)%FMT)
00225       CASE ('SERAFIN ','SERAFIND')
00226         CALL WRITE_DATA_SERAFIN(CP_FILES(3)%LU,NUMVARUR3D2RES,
00227      &        USERTIME,LT,
00228      &        UR3D_FILES_OUTVAR,URBLOC3D,
00229      &        CP_FILES(3)%FMT,VSP_FRA(1)%DIM1)
00230 !
00231       CASE ('MED     ')
00232 !
00233       CASE DEFAULT
00234         IF(LNG.EQ.1) THEN
00235           WRITE(LU,*) 'WRITE_DATA : MAUVAIS FORMAT : ',CP_FILES(3)%FMT
00236         ENDIF
00237         IF(LNG.EQ.2) THEN
00238           WRITE(LU,*) 'WRITE_DATA: BAD FILE FORMAT : ',CP_FILES(3)%FMT
00239         ENDIF
00240         CALL PLANTE(1)
00241       END SELECT
00242 !
00243 !-----------------------------------------------------------------------
00244 ! WRITE TIME STEP TO 2DHYD_AS_3D
00245 !-----------------------------------------------------------------------
00246 !
00247       SELECT CASE (CP_FILES(4)%FMT)
00248       CASE ('SERAFIN ','SERAFIND')
00249         CALL WRITE_DATA_SERAFIN(CP_FILES(4)%LU,NUMVAR2DHYD,
00250      &        USERTIME,LT,
00251      &        UR2DHYD_FILES_OUTVAR,URBLOC2DHYD,
00252      &        CP_FILES(4)%FMT,UR2DHYD(1)%DIM1)
00253 !
00254       CASE ('MED     ')
00255 !
00256       CASE DEFAULT
00257         IF(LNG.EQ.1) THEN
00258           WRITE(LU,*) 'WRITE_DATA : MAUVAIS FORMAT : ',CP_FILES(4)%FMT
00259         ENDIF
00260         IF(LNG.EQ.2) THEN
00261           WRITE(LU,*) 'WRITE_DATA: BAD FILE FORMAT : ',CP_FILES(4)%FMT
00262         ENDIF
00263         CALL PLANTE(1)
00264       END SELECT
00265 !
00266 !-----------------------------------------------------------------------
00267 !
00268       RETURN
00269       END

Generated on Fri Aug 31 2013 18:12:58 by S.E.Bourban (HRW) using doxygen 1.7.0