-
Notifications
You must be signed in to change notification settings - Fork 0
/
#flac.f90#
59 lines (41 loc) · 1.22 KB
/
#flac.f90#
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
!-*- F90 -*-
! --------- Flac -------------------------
subroutine flac
use arrays
include 'precision.inc'
include 'params.inc'
include 'arrays.inc'
! Update Thermal State
! Skip the therm calculations if itherm = 3
if (itherm .eq. 3) goto 222
call fl_therm
222 continue
if (itherm .eq.2) goto 500 ! Thermal calculation only
! Calculation of strain rates from velocity
call fl_srate
! Changing marker phases
! XXX: change_phase is slow, don't call it every loop
!Hao commented following line to skip phase change 5.15.2018
!if( mod(nloop, 10).eq.0 ) call change_phase_dike
! Update stresses by constitutive law (and mix isotropic stresses)
call fl_rheol
! update stress boundary conditions
if (ynstressbc.eq.1.) call bc_update
! Calculations in a node: forces, balance, velocities, new coordinates
call fl_node
! New coordinates
call fl_move
! calculate diking thermal effect
!if (ny_inject.gt.2) then
call fl_injectheat
!print*,"call injectheat"
!endif
! Adjust real masses due to temperature
if( mod(nloop,ifreq_rmasses).eq.0 ) call rmasses
! Adjust inertial masses or time step due to deformations
if( mod(nloop,ifreq_imasses) .eq. 0 ) call dt_mass
! Adjust time Step
call dt_adjust
500 continue
return
end subroutine flac