[638] | 1 | MODULE data_unstructured_mod |
---|
| 2 | USE ISO_C_BINDING |
---|
| 3 | USE OMP_LIB |
---|
| 4 | IMPLICIT NONE |
---|
| 5 | SAVE |
---|
| 6 | |
---|
| 7 | #define BINDC_(thename) BIND(C, name=#thename) |
---|
| 8 | #define BINDC(thename) BINDC_(dynamico_ ## thename) |
---|
| 9 | |
---|
| 10 | #define DBL REAL(C_DOUBLE) |
---|
| 11 | #define DOUBLE1(m) DBL, DIMENSION(m) |
---|
| 12 | #define DOUBLE2(m,n) DBL, DIMENSION(m,n) |
---|
| 13 | #define DOUBLE3(m,n,p) DBL, DIMENSION(m,n,p) |
---|
| 14 | #define DOUBLE4(m,n,p,q) DBL, DIMENSION(m,n,p,q) |
---|
| 15 | #define INDEX INTEGER(C_INT) |
---|
| 16 | |
---|
| 17 | INTEGER, PARAMETER :: eta_mass=1, eta_lag=2, & |
---|
| 18 | thermo_theta=1, thermo_entropy=2, thermo_moist=3, thermo_boussinesq=4, & |
---|
| 19 | caldyn_vert_cons=1, max_nb_stage=5 |
---|
| 20 | INTEGER(C_INT), BIND(C) :: caldyn_thermo=thermo_theta, caldyn_eta=eta_lag, & |
---|
| 21 | caldyn_vert_variant=caldyn_vert_cons, nb_threads=0, nb_stage=0 |
---|
| 22 | LOGICAL(C_BOOL), BIND(C) :: hydrostatic=.TRUE., debug_hevi_solver=.TRUE. |
---|
| 23 | |
---|
| 24 | INDEX, BIND(C) :: llm, nqdyn, edge_num, primal_num, dual_num, & |
---|
| 25 | max_primal_deg, max_dual_deg, max_trisk_deg |
---|
| 26 | INDEX, ALLOCATABLE :: & ! deg(ij) = nb of vertices = nb of edges of primal/dual cell ij |
---|
| 27 | primal_deg(:), primal_edge(:,:), primal_vertex(:,:), primal_ne(:,:), & |
---|
| 28 | dual_deg(:), dual_edge(:,:), dual_vertex(:,:), dual_ne(:,:), & |
---|
| 29 | trisk_deg(:), trisk(:,:), & |
---|
| 30 | left(:), right(:), up(:), down(:) |
---|
| 31 | ! left and right are adjacent primal cells |
---|
| 32 | ! flux is positive when going from left to right |
---|
| 33 | ! up and down are adjacent dual cells |
---|
| 34 | ! circulation is positive when going from down to up |
---|
| 35 | |
---|
| 36 | DBL, BIND(C) :: elapsed, g, ptop, cpp, cppv, Rd, Rv, preff, Treff, & |
---|
| 37 | pbot, Phi_bot, rho_bot |
---|
| 38 | DBL :: kappa |
---|
| 39 | DOUBLE1(max_nb_stage), BIND(C) :: tauj ! diagonal of fast Butcher tableau |
---|
| 40 | DOUBLE2(max_nb_stage,max_nb_stage), BIND(C) :: cslj, cflj ! slow and fast modified Butcher tableaus |
---|
| 41 | DOUBLE1(:), ALLOCATABLE :: le_de, fv, Av, Ai |
---|
| 42 | DOUBLE2(:,:), ALLOCATABLE :: Riv2, wee, ap,bp, mass_bl, mass_dak, mass_dbk |
---|
| 43 | |
---|
| 44 | INTEGER(C_INT), BIND(C) :: comm_icosa |
---|
| 45 | |
---|
| 46 | CONTAINS |
---|
| 47 | |
---|
| 48 | |
---|
| 49 | !---------------------------- CONTEXT INITIALIZATION -------------------------- |
---|
| 50 | |
---|
| 51 | #define ALLOC1(v,n1) IF(ALLOCATED(v)) DEALLOCATE(v) ; ALLOCATE(v(n1)) |
---|
| 52 | #define ALLOC2(v,n1,n2) IF(ALLOCATED(v)) DEALLOCATE(v) ; ALLOCATE(v(n1,n2)) |
---|
| 53 | |
---|
| 54 | SUBROUTINE init_mesh( & |
---|
| 55 | primal_deg_, primal_edge_, primal_ne_, & |
---|
| 56 | dual_deg_, dual_edge_, dual_ne_, dual_vertex_, & |
---|
| 57 | left_, right_, up_, down_ ,& |
---|
| 58 | trisk_deg_, trisk_) BINDC(init_mesh) |
---|
| 59 | INDEX :: primal_deg_(primal_num), primal_edge_(max_primal_deg,primal_num), & |
---|
| 60 | primal_ne_(max_primal_deg,primal_num), & |
---|
| 61 | dual_deg_(dual_num), dual_edge_(max_dual_deg,dual_num), & |
---|
| 62 | dual_ne_(max_dual_deg,dual_num), & |
---|
| 63 | dual_vertex_(max_dual_deg,dual_num), & |
---|
| 64 | trisk_deg_(edge_num), trisk_(max_trisk_deg, edge_num) |
---|
| 65 | INDEX, DIMENSION(edge_num) :: left_, right_, down_, up_ |
---|
| 66 | |
---|
| 67 | PRINT *, 'init_mesh ...' |
---|
| 68 | PRINT *, 'Primal mesh : ', primal_num, max_primal_deg |
---|
| 69 | PRINT *, 'Dual mesh : ', dual_num, max_dual_deg |
---|
| 70 | PRINT *, 'Edge mesh : ', edge_num, max_trisk_deg |
---|
| 71 | PRINT *, 'Vertical levels :', llm |
---|
| 72 | ALLOC1(primal_deg, primal_num) |
---|
| 73 | ALLOC2(primal_edge, max_primal_deg,primal_num) |
---|
| 74 | ALLOC2(primal_ne, max_primal_deg,primal_num) |
---|
| 75 | ALLOC1(dual_deg,dual_num) |
---|
| 76 | ALLOC2(dual_edge, max_dual_deg,dual_num) |
---|
| 77 | ALLOC2(dual_ne, max_dual_deg,dual_num) |
---|
| 78 | ALLOC2(dual_vertex, max_dual_deg,dual_num) |
---|
| 79 | ALLOC1(trisk_deg, edge_num) |
---|
| 80 | ALLOC2(trisk, max_trisk_deg, edge_num) |
---|
| 81 | PRINT *, SHAPE(trisk), edge_num |
---|
| 82 | ALLOC1(left, edge_num) |
---|
| 83 | ALLOC1(right, edge_num) |
---|
| 84 | ALLOC1(up, edge_num) |
---|
| 85 | ALLOC1(down, edge_num) |
---|
| 86 | primal_deg(:) = primal_deg_(:) |
---|
| 87 | primal_edge(:,:) = primal_edge_(:,:) |
---|
| 88 | primal_ne(:,:) = primal_ne_(:,:) |
---|
| 89 | dual_deg(:) = dual_deg_(:) |
---|
| 90 | dual_edge(:,:) = dual_edge_(:,:) |
---|
| 91 | dual_ne(:,:) = dual_ne_(:,:) |
---|
| 92 | dual_vertex(:,:) = dual_vertex_(:,:) |
---|
| 93 | IF(MINVAL(dual_deg)<3) THEN |
---|
| 94 | STOP 'At least one dual cell has less than 3 vertices' |
---|
| 95 | END IF |
---|
| 96 | IF(MINVAL(primal_deg)<3) THEN |
---|
| 97 | STOP 'At least one primal cell has less than 3 vertices' |
---|
| 98 | END IF |
---|
| 99 | left(:)=left_(:) |
---|
| 100 | right(:)=right_(:) |
---|
| 101 | down(:)=down_(:) |
---|
| 102 | up=up_(:) |
---|
| 103 | trisk_deg(:)=trisk_deg_(:) |
---|
| 104 | trisk(:,:)=trisk_(:,:) |
---|
| 105 | PRINT *, MAXVAL(primal_edge), edge_num |
---|
| 106 | PRINT *, MAXVAL(dual_edge), edge_num |
---|
| 107 | PRINT *, MAXVAL(dual_vertex), dual_num |
---|
| 108 | PRINT *, MAXVAL(trisk), edge_num |
---|
| 109 | PRINT *, MAX(MAXVAL(left),MAXVAL(right)), primal_num |
---|
| 110 | PRINT *, MAX(MAXVAL(up),MAXVAL(down)), dual_num |
---|
| 111 | PRINT *, SHAPE(trisk), edge_num |
---|
| 112 | PRINT *,' ... Done.' |
---|
| 113 | END SUBROUTINE init_mesh |
---|
| 114 | |
---|
| 115 | SUBROUTINE init_metric(Ai_, Av_, fv_, le_de_, Riv2_, wee_) BINDC(init_metric) |
---|
| 116 | DOUBLE1(primal_num) :: Ai_ |
---|
| 117 | DOUBLE1(dual_num) :: Av_, fv_ |
---|
| 118 | DOUBLE1(edge_num) :: le_de_ |
---|
| 119 | DOUBLE2(max_dual_deg,dual_num) :: Riv2_ |
---|
| 120 | DOUBLE2(max_trisk_deg,edge_num) :: wee_ |
---|
| 121 | PRINT *, 'init_metric ...' |
---|
| 122 | ALLOC1(Ai,primal_num) |
---|
| 123 | ALLOC1(Av,dual_num) |
---|
| 124 | ALLOC1(fv,dual_num) |
---|
| 125 | ALLOC1(le_de,edge_num) |
---|
| 126 | ALLOC2(Riv2, max_dual_deg, dual_num) |
---|
| 127 | ALLOC2(wee, max_trisk_deg, edge_num) |
---|
| 128 | Ai(:) = Ai_(:) |
---|
| 129 | Av(:) = Av_(:) |
---|
| 130 | fv(:) = fv_(:) |
---|
| 131 | le_de(:) = le_de_(:) |
---|
| 132 | Riv2(:,:)=Riv2_(:,:) |
---|
| 133 | wee(:,:) = wee_(:,:) |
---|
| 134 | PRINT *, MAXVAL(ABS(Ai)) |
---|
| 135 | PRINT *, MAXVAL(ABS(Av)) |
---|
| 136 | PRINT *, MAXVAL(ABS(fv)) |
---|
| 137 | PRINT *, MAXVAL(ABS(le_de)) |
---|
| 138 | PRINT *, MAXVAL(ABS(Riv2)) |
---|
| 139 | PRINT *, MAXVAL(ABS(wee)) |
---|
| 140 | PRINT *, MINVAL(right), MAXVAL(right) |
---|
| 141 | PRINT *, MINVAL(right), MAXVAL(left) |
---|
| 142 | PRINT *,' ... Done.' |
---|
| 143 | IF(nb_threads==0) nb_threads=OMP_GET_MAX_THREADS() |
---|
| 144 | PRINT *,'OpenMP : max_threads, num_procs, nb_threads', OMP_GET_MAX_THREADS(), omp_get_num_procs(), nb_threads |
---|
| 145 | |
---|
| 146 | END SUBROUTINE init_metric |
---|
| 147 | ! |
---|
| 148 | SUBROUTINE init_params() BINDC(init_params) |
---|
| 149 | PRINT *, 'Setting physical parameters ...' |
---|
| 150 | IF(hydrostatic) THEN |
---|
| 151 | PRINT *, 'Hydrostatic dynamics (HPE)' |
---|
| 152 | ELSE |
---|
| 153 | PRINT *, 'Non-hydrostatic dynamics (Euler)' |
---|
| 154 | END IF |
---|
| 155 | kappa = Rd/cpp |
---|
| 156 | PRINT *, 'g = ',g |
---|
| 157 | PRINT *, 'preff = ',preff |
---|
| 158 | PRINT *, 'Treff = ',Treff |
---|
| 159 | PRINT *, 'Rd = ',Rd |
---|
| 160 | PRINT *, 'cpp = ',cpp |
---|
| 161 | PRINT *, 'kappa = ',kappa |
---|
| 162 | PRINT *, '... Done' |
---|
| 163 | END SUBROUTINE init_params |
---|
| 164 | ! |
---|
| 165 | SUBROUTINE init_hybrid(bl,dak,dbk) BINDC(init_hybrid) |
---|
| 166 | DOUBLE2(llm+1, primal_num) :: bl |
---|
| 167 | DOUBLE2(llm, primal_num) :: dak,dbk |
---|
| 168 | PRINT *, 'Setting hybrid coefficients ...' |
---|
| 169 | ALLOC2(mass_bl, llm+1, primal_num) |
---|
| 170 | ALLOC2(mass_dak, llm, primal_num) |
---|
| 171 | ALLOC2(mass_dbk, llm, primal_num) |
---|
| 172 | mass_bl(:,:) = bl(:,:) |
---|
| 173 | mass_dak(:,:) = dak(:,:) |
---|
| 174 | mass_dbk(:,:) = dbk(:,:) |
---|
| 175 | PRINT *, '... Done, llm = ', llm |
---|
| 176 | END SUBROUTINE Init_hybrid |
---|
| 177 | |
---|
| 178 | END MODULE data_unstructured_mod |
---|