The TELEMAC-MASCARET system  trunk
preres_khione.f
Go to the documentation of this file.
1 ! ************************
2  SUBROUTINE preres_khione
3 ! ************************
4 !
5  &(npoin,lt,telsor,tn)
6 !
7 !***********************************************************************
8 ! KHIONE V7P3
9 !***********************************************************************
10 !
11 !brief PREPARES THE VARIABLES WHICH WILL BE WRITTEN TO
12 !+ THE RESULTS FILE OR TO THE LISTING.
13 !
14 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
15 !| LT |-->| CURRENT NUMBER OF OF TIME STEP
16 !| NPOIN |-->| NUMBER OF NODES
17 !| TELSOR |-->| OUTPUT OF TELEMAC2D
18 !| TN |-->| TELEMAC2D TRACER VALUES
19 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
20 !
21  USE bief
23 !
25  IMPLICIT NONE
26 !
27 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
28 !
29  INTEGER, INTENT(IN) :: LT,NPOIN
30  TYPE(bief_obj), INTENT(IN) :: TELSOR,TN
31 !
32 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
33 !
34  INTEGER I
35  LOGICAL IMP,LEO
36 !
37 !-----------------------------------------------------------------------
38 !
39  imp = .false.
40  leo = .false.
41  IF( lt.EQ.(lt/lisprd)*lisprd ) imp = .true.
42  IF( lt.EQ.(lt/leoprd)*leoprd ) leo = .true.
43 !
44 ! NO PRINTOUT REQUIRED (LISTING OR RESULT FILE): EXITS
45  IF( .NOT.(leo.OR.imp) ) RETURN
46 !
47 !-----------------------------------------------------------------------
48 !
49 ! INITIALISATION PART
50 !
51  IF( lt.EQ.0 ) THEN
52  ENDIF
53 !
54 !-----------------------------------------------------------------------
55 !
56 ! FOR EVERY TIME STEP
57 !
58 !=======================================================================
59 ! COMPUTES THE EQUIVALENT SURFACE ELEVATION
60 !=======================================================================
61 !
62  IF( (leo.AND.sorleo(16)).OR.(imp.AND.sorimp(16)) ) THEN
63 ! TELSOR%ADR(4)%P: H
64 ! TELSOR%ADR(6)%P: ZF
65  DO i = 1,npoin
66  t3%R(i) = telsor%ADR(4)%P%R(i) + telsor%ADR(6)%P%R(i) +
67  & rho_ice/ro0 * ( thifems%R(i) + thifemf%R(i) + hun%R(i) )
68  ENDDO
69  ENDIF
70 !
71 !=======================================================================
72 ! COMPUTES THE TOP OF THE ICE COVER
73 !=======================================================================
74 !
75  IF( (leo.AND.sorleo(17)).OR.(imp.AND.sorimp(17)) ) THEN
76 ! TELSOR%ADR(4)%P: H
77 ! TELSOR%ADR(6)%P: ZF
78  DO i = 1,npoin
79  t4%R(i) = telsor%ADR(4)%P%R(i) + telsor%ADR(6)%P%R(i) +
80  & ( thifems%R(i) + thifemf%R(i) + hun%R(i) )
81  ENDDO
82  ENDIF
83 !
84 !=======================================================================
85 ! COMPUTES THE BOTTOM OF THE ICE COVER, ALSO THE SURFACE ELEVATION
86 !=======================================================================
87 !
88  IF( (leo.AND.sorleo(18)).OR.(imp.AND.sorimp(18)) ) THEN
89 ! TELSOR%ADR(4)%P: H
90 ! TELSOR%ADR(6)%P: ZF
91  CALL os( 'X=Y+Z ', x=t5,y=telsor%ADR(4)%P,z=telsor%ADR(6)%P )
92  ENDIF
93 !
94 !=======================================================================
95 ! CONVERTER ICE CHARACTERISTICS (PRIME NUMBER) INTO ITS REAL PART
96 !=======================================================================
97 !
98  IF( (leo.AND.sorleo(20)).OR.(imp.AND.sorimp(20)) ) THEN
99  DO i = 1,npoin
100  icetype%R(i) = 1.d0 * icetype%I(i)
101  ENDDO
102  ENDIF
103 !
104 !=======================================================================
105 ! COMPUTES TOTAL CONCENTRATION
106 !=======================================================================
107 !
108  IF( (leo.AND.sorleo(22)).OR.(imp.AND.sorimp(22)) ) THEN
109  CALL os('X=Y ', x=ctot, y=tn%ADR(ind_fra)%P)
110  IF(nc_fra.GT.1) THEN
111  DO i = 2,nc_fra
112  CALL os('X=X+Y ', x=ctot, y=tn%ADR(ind_fra+i-1)%P)
113  ENDDO
114  ENDIF
115  ENDIF
116 !
117 !=======================================================================
118 ! COMPUTES TOTAL NUMBER OF PARTICLES
119 !=======================================================================
120 !
121  IF( (leo.AND.sorleo(21)).OR.(imp.AND.sorimp(21)) ) THEN
122  CALL os('X=CY ', x=ntot, y=tn%ADR(ind_fra)%P,
123  & c=1.d0/vk_frzl(1))
124  IF(nc_fra.GT.1) THEN
125  DO i = 2,nc_fra
126  CALL os('X=X+CY ', x=ntot, y=tn%ADR(ind_fra+i-1)%P,
127  & c=1.d0/vk_frzl(i))
128  ENDDO
129  ENDIF
130  ENDIF
131 !
132 !=======================================================================
133 ! VARIABLES OF THERMAL BUDGET FROM T2D TRACER
134 !=======================================================================
135 !
136  DO i=1,nc_fra
137  IF( (leo.AND.sorleo(22+i)).OR.(imp.AND.sorimp(22+i)) ) THEN
138  CALL os('X=Y ', x=frzl%ADR(i)%P, y=tn%ADR(ind_fra+i-1)%P)
139  ENDIF
140  ENDDO
141 !
142  DO i=1,nc_fra
143  IF( (leo.AND.sorleo(22+i+nc_fra))
144  & .OR.(imp.AND.sorimp(22+i+nc_fra)) ) THEN
145  CALL os('X=CY ', x=nbp%ADR(i)%P, y=tn%ADR(ind_fra+i-1)%P,
146  & c=vk_frzl(i))
147  ENDIF
148  ENDDO
149 !
150  IF( (leo.AND.sorleo(22+2*nc_fra+1))
151  & .OR.(imp.AND.sorimp(22+2*nc_fra+1)) ) THEN
152  CALL os('X=Y ', x=temp, y=tn%ADR(ind_t)%P)
153  ENDIF
154 !
155  IF( (leo.AND.sorleo(22+2*nc_fra+2))
156  & .OR.(imp.AND.sorimp(22+2*nc_fra+2)) ) THEN
157  CALL os('X=Y ', x=sal, y=tn%ADR(ind_s)%P)
158  ENDIF
159 !
160 !=======================================================================
161 !
162 !-----------------------------------------------------------------------
163 !
164  RETURN
165  END
type(bief_obj), pointer t5
type(bief_obj), target temp
type(bief_obj), target ntot
type(bief_obj), target sal
subroutine preres_khione(NPOIN, LT, TELSOR, TN)
Definition: preres_khione.f:7
type(bief_obj), target nbp
type(bief_obj), target hun
double precision, dimension(:), allocatable vk_frzl
type(bief_obj), target icetype
type(bief_obj), target ctot
logical, dimension(maxvar) sorleo
subroutine os(OP, X, Y, Z, C, IOPT, INFINI, ZERO)
Definition: os.f:7
double precision rho_ice
type(bief_obj), pointer t4
type(bief_obj), pointer t3
type(bief_obj), target thifemf
type(bief_obj), target frzl
type(bief_obj), target thifems
Definition: bief.f:3
logical, dimension(maxvar) sorimp