[3326] | 1 | ! -*- Mode: f90 -*- |
---|
| 2 | MODULE modeles |
---|
| 3 | !> Declare tous les tableaux |
---|
| 4 | !! |
---|
| 5 | USE declare |
---|
| 6 | USE dimensions |
---|
| 7 | USE mod_prih |
---|
| 8 | !! |
---|
| 9 | IMPLICIT NONE |
---|
| 10 | !! |
---|
| 11 | SAVE |
---|
| 12 | PUBLIC |
---|
| 13 | !! |
---|
| 14 | REAL (kind=rl), PARAMETER :: eps = EPSILON (1.0_rl) !< Standard precision epsilon |
---|
| 15 | REAL (kind=rl), PARAMETER :: eps10 = 10.0_rl * eps !< Standard precision epsilon * 10 |
---|
| 16 | REAL (kind=rl), PARAMETER :: epsd = EPSILON (1.0_rd) !< Quadruple precision epsilon |
---|
| 17 | REAL (kind=rl), PARAMETER :: epsd10 = 10.0_rd * epsd !< Quadruple precision epsilon * 10 |
---|
| 18 | !! |
---|
[3918] | 19 | |
---|
| 20 | !! |
---|
[3326] | 21 | |
---|
| 22 | REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: yas, yan, xaw, xae !< Limits of atmos box (south, north, west, east) |
---|
| 23 | REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: yos, yon, xow, xoe !< Limits of atmos box (south, north, west, east) |
---|
| 24 | REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: xolont, xolatt, xosrft !< Lon, lat and surface at T point for ocean |
---|
| 25 | REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: xolonu, xolatu, xosrfu !< idem point u |
---|
| 26 | REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: xolonv, xolatv, xosrfv !< idem point v |
---|
| 27 | REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: xolonf, xolatf, xosrff !< idem point f |
---|
| 28 | REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: xalont, xalatt, xasrft !< For atmosphere |
---|
| 29 | REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: xalonu, xalatu, xasrfu |
---|
| 30 | REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: xalonv, xalatv, xasrfv |
---|
| 31 | REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: xasrft_pol, xosrft_pol !< Surfaces calculées par les polygones. |
---|
| 32 | INTEGER (kind=il), DIMENSION (:), ALLOCATABLE :: nborda !< 1 if atmosphere point is over some land point of ocean grid |
---|
| 33 | INTEGER (kind=il), DIMENSION (:), ALLOCATABLE :: nbordo !< 1 if ocean point is over some land point of atmos grid |
---|
| 34 | REAL (kind=rl) , DIMENSION (:,:), ALLOCATABLE :: wo2a !< Weigts of interpolation ocean -> atmosphere |
---|
| 35 | INTEGER(kind=il) , DIMENSION (:,:), ALLOCATABLE :: ko2a !< Adresses ocean -> atmosphere |
---|
| 36 | REAL (kind=rl) , DIMENSION (:,:), ALLOCATABLE :: wa2o !< Weights of interpolation atmosphere -> ocean |
---|
| 37 | INTEGER (kind=il), DIMENSION (:,:), ALLOCATABLE :: ka2o ! Adresses atmosphere -> ocean |
---|
| 38 | REAL (kind=rl) , DIMENSION (:), ALLOCATABLE :: wasum !< Sum of weights of interpolation atmosphere -> ocean |
---|
| 39 | REAL (kind=rl) , DIMENSION (:), ALLOCATABLE :: wosum !< Sum of weights of interpolation ocean -> atmosphere |
---|
| 40 | INTEGER (kind=il), DIMENSION (:), ALLOCATABLE :: nva !< Number of ocean neighbor for each atm point |
---|
| 41 | INTEGER (kind=il), DIMENSION (:), ALLOCATABLE :: nvo !< Number of atmos neighbor for each ocean point |
---|
| 42 | INTEGER (kind=il), DIMENSION (:), ALLOCATABLE :: iomskt, iomsku, iomskv, iomskf !< Mask ocean model (sea=0, land=1) |
---|
| 43 | INTEGER (kind=il), DIMENSION (:), ALLOCATABLE :: iamskt, iamsku, iamskv !< Mask atm model (sea=0, land=1) |
---|
| 44 | INTEGER (kind=il), DIMENSION (:), ALLOCATABLE :: iamskp !< Mask to remove redundant point by periodicity and north folding |
---|
| 45 | INTEGER (kind=il), DIMENSION (:), ALLOCATABLE :: iomskp !< Mask to remove redundant point by periodicity and north folding |
---|
| 46 | REAL (kind=rl) , DIMENSION (:, :), ALLOCATABLE :: xo_ed !< Longitude of corner of oce boxes |
---|
| 47 | !< UL,UM,UR,MR,LR,LM,LL,ML.9 for middle of box |
---|
| 48 | REAL (kind=rl) , DIMENSION (:, :), ALLOCATABLE :: yo_ed !< Lat |
---|
| 49 | REAL (kind=rl) , DIMENSION (:, :), ALLOCATABLE :: xa_ed !< Atm |
---|
| 50 | REAL (kind=rl) , DIMENSION (:, :), ALLOCATABLE :: ya_ed |
---|
| 51 | !! |
---|
| 52 | CHARACTER (LEN=4) :: comod_a, comod_t, comod_u, comod_v, comod_f |
---|
| 53 | CHARACTER (LEN=4) :: camod_a, camod_t, camod_u, camod_v, camod_f |
---|
| 54 | !! |
---|
| 55 | INTEGER (kind=il) :: maxo, maxa ! |
---|
| 56 | INTEGER (kind=il) :: nsum !< Ponderation suivant le type de point trouve |
---|
| 57 | !! |
---|
| 58 | REAL (kind=rl) :: xinf, xsup !< Longitudes minimales et maximales de travail |
---|
| 59 | INTEGER (kind=il) :: ngrd, nsrf, nmsk, nwei4o2a, nwei4a2o, nwei8o2a, nwei8a2o, nchk, ndeb, nbug1, nwei8, nwei4 !< IO unit numbers |
---|
| 60 | !! |
---|
| 61 | REAL (kind=rl) :: ra = 6371229.0_rl !< Earth Radius (for OPA) |
---|
| 62 | REAL (kind=rl) :: xsurfa, xsurfo !< Earth surface in each model |
---|
| 63 | !! |
---|
| 64 | CHARACTER (LEN = 8) :: cladress, clweight !< Name of OASIS weights/adresses |
---|
| 65 | |
---|
| 66 | ! |
---|
| 67 | REAL(kind=rl), DIMENSION (:), ALLOCATABLE :: o2amask !< Ocean mask interpolated toward atmosphere |
---|
| 68 | REAL(kind=rl), DIMENSION (:), ALLOCATABLE :: a2omask !< Atmosphere mask interpolated toward ocean |
---|
| 69 | REAL(kind=rl), DIMENSION (:), ALLOCATABLE :: o2afull !< 1 on ocean interpolated toward atmosphere |
---|
| 70 | REAL(kind=rl), DIMENSION (:), ALLOCATABLE :: a2ofull !< 1 on atmosphere interpolated toward ocean |
---|
| 71 | ! |
---|
| 72 | INTEGER, DIMENSION (:), ALLOCATABLE :: o2amask_i_int !< Ocean mask interpolated toward atmosphere : full land only |
---|
| 73 | INTEGER, DIMENSION (:), ALLOCATABLE :: o2amask_i_ext !< Ocean mask interpolated toward atmosphere : all points with some land |
---|
| 74 | INTEGER, DIMENSION (:), ALLOCATABLE :: a2omask_i_int !< Atmosphere mask interpolated toward ocean : full land only |
---|
| 75 | INTEGER, DIMENSION (:), ALLOCATABLE :: a2omask_i_ext !< Atmosphere mask interpolated toward ocean : all points with some land |
---|
| 76 | !! |
---|
| 77 | INTEGER (kind = il), DIMENSION (:), ALLOCATABLE :: m2ai, m2aj, m2oi, m2oj, moi, moj, mai, maj |
---|
| 78 | INTEGER (kind = il), DIMENSION (:, :), ALLOCATABLE :: m1a, m1ar, m1o, m1or |
---|
| 79 | !! |
---|
| 80 | CONTAINS |
---|
| 81 | !! |
---|
| 82 | SUBROUTINE alloc_modeles |
---|
| 83 | !> Dimensionne tout les tableaux necessaires |
---|
| 84 | IMPLICIT NONE |
---|
| 85 | !! |
---|
| 86 | INTEGER (kind=il) :: ja, jo, jai, jaj, joi, joj |
---|
| 87 | INTEGER :: ierr |
---|
| 88 | !! |
---|
| 89 | WRITE (nout, *) 'Data types ' |
---|
| 90 | WRITE (nout, *) 'r_4 : ', r_4, 1.0_r_4, TINY(1.0_r_4), HUGE(1.0_r_4), EPSILON (1.0_r_4) |
---|
| 91 | WRITE (nout, *) 'r_8 : ', r_8, 1.0_r_8, TINY(1.0_r_8), HUGE(1.0_r_8), EPSILON (1.0_r_8) |
---|
| 92 | WRITE (nout, *) 'rd : ', rd , 1.0_rd , TINY(1.0_rd) , HUGE(1.0_rd) , EPSILON (1.0_rd) |
---|
| 93 | WRITE (nout, *) 'rl : ', rl , 1.0_rl , TINY(1.0_rl) , HUGE(1.0_rl) , EPSILON (1.0_rl) |
---|
| 94 | !! |
---|
| 95 | ALLOCATE (yas (jpan) , STAT=ierr) ; CALL chk_allo (ierr, 'yas', lreset = .TRUE., crout = 'common') |
---|
| 96 | ALLOCATE (yan (jpan) , STAT=ierr) ; CALL chk_allo (ierr, 'yan') |
---|
| 97 | ALLOCATE (xaw (jpan) , STAT=ierr) ; CALL chk_allo (ierr, 'xaw') |
---|
| 98 | ALLOCATE (xae (jpan) , STAT=ierr) ; CALL chk_allo (ierr, 'xae') |
---|
| 99 | |
---|
| 100 | ALLOCATE (yos (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'yos') |
---|
| 101 | ALLOCATE (yon (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'yon') |
---|
| 102 | ALLOCATE (xow (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'xow') |
---|
| 103 | ALLOCATE (xoe (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'xoe') |
---|
| 104 | ! |
---|
| 105 | ALLOCATE (xolont (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'xolont') |
---|
| 106 | ALLOCATE (xolonu (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'xolonu') |
---|
| 107 | ALLOCATE (xolonv (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'xolonv') |
---|
| 108 | ALLOCATE (xolonf (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'xolonf') |
---|
| 109 | ALLOCATE (xolatt (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'xolatt') |
---|
| 110 | ALLOCATE (xolatu (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'xolatu') |
---|
| 111 | ALLOCATE (xolatv (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'xolatv') |
---|
| 112 | ALLOCATE (xolatf (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'xolatf') |
---|
| 113 | ALLOCATE (xosrft (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'xosrft') |
---|
| 114 | ALLOCATE (xosrfu (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'xosrfu') |
---|
| 115 | ALLOCATE (xosrfv (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'xosrfv') |
---|
| 116 | ALLOCATE (xosrff (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'xosrff') |
---|
| 117 | ! |
---|
| 118 | ALLOCATE (xosrft_pol (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'xosrft_pol') |
---|
| 119 | ALLOCATE (xasrft_pol (jpan) , STAT=ierr) ; CALL chk_allo (ierr, 'xasrft_pol') |
---|
| 120 | ! |
---|
| 121 | ALLOCATE (xalont (jpan) , STAT=ierr) ; CALL chk_allo (ierr, 'xalont') |
---|
| 122 | ALLOCATE (xalonu (jpan) , STAT=ierr) ; CALL chk_allo (ierr, 'xalonu') |
---|
| 123 | ALLOCATE (xalonv (jpanv), STAT=ierr) ; CALL chk_allo (ierr, 'xalonv') |
---|
| 124 | ALLOCATE (xalatt (jpan) , STAT=ierr) ; CALL chk_allo (ierr, 'xalatt') |
---|
| 125 | ALLOCATE (xalatu (jpan) , STAT=ierr) ; CALL chk_allo (ierr, 'xalatu') |
---|
| 126 | ALLOCATE (xalatv (jpanv), STAT=ierr) ; CALL chk_allo (ierr, 'xalatv') |
---|
| 127 | ALLOCATE (xasrft (jpan) , STAT=ierr) ; CALL chk_allo (ierr, 'xasrft') |
---|
| 128 | ALLOCATE (xasrfu (jpan) , STAT=ierr) ; CALL chk_allo (ierr, 'xasrfu') |
---|
| 129 | ALLOCATE (xasrfv (jpanv), STAT=ierr) ; CALL chk_allo (ierr, 'xasrfv') |
---|
| 130 | ! |
---|
| 131 | ALLOCATE (nborda (jpan) , STAT=ierr) ; CALL chk_allo (ierr, 'nborda') |
---|
| 132 | ALLOCATE (nbordo (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'nbordo') |
---|
| 133 | ! |
---|
| 134 | ALLOCATE (wo2a (jpo2a,jpan), STAT=ierr) ; CALL chk_allo (ierr, 'wo2a') |
---|
| 135 | ALLOCATE (ko2a (jpo2a,jpan), STAT=ierr) ; CALL chk_allo (ierr, 'ko2a') |
---|
| 136 | ALLOCATE (wa2o (jpa2o,jpon), STAT=ierr) ; CALL chk_allo (ierr, 'wa2o') |
---|
| 137 | ALLOCATE (ka2o (jpa2o,jpon), STAT=ierr) ; CALL chk_allo (ierr, 'ka2o') |
---|
| 138 | |
---|
| 139 | ALLOCATE (wasum (jpan) , STAT=ierr) ; CALL chk_allo (ierr, 'wasum') |
---|
| 140 | ALLOCATE (wosum (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'wosum') |
---|
| 141 | ! |
---|
| 142 | ALLOCATE (nvo (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'nvo') |
---|
| 143 | ALLOCATE (nva (jpan), STAT=ierr) ; CALL chk_allo (ierr, 'nva') |
---|
| 144 | ! |
---|
| 145 | ALLOCATE (iomskt (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'iomskt') |
---|
| 146 | ALLOCATE (iomsku (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'iomsku') |
---|
| 147 | ALLOCATE (iomskv (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'iomskv') |
---|
| 148 | ALLOCATE (iomskf (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'iomskf') |
---|
| 149 | ALLOCATE (iamskt (jpan) , STAT=ierr) ; CALL chk_allo (ierr, 'iamskt') |
---|
| 150 | ALLOCATE (iamsku (jpan) , STAT=ierr) ; CALL chk_allo (ierr, 'iamsku') |
---|
| 151 | ALLOCATE (iamskv (jpanv), STAT=ierr) ; CALL chk_allo (ierr, 'iamskv') |
---|
| 152 | ALLOCATE (iomskp (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'iomskp') |
---|
| 153 | ALLOCATE (iamskp (jpan) , STAT=ierr) ; CALL chk_allo (ierr, 'iamskp') |
---|
| 154 | ! |
---|
| 155 | ALLOCATE (xo_ed (jpon, jpoe), STAT=ierr) ; CALL chk_allo (ierr, 'xo_ed') |
---|
| 156 | ALLOCATE (yo_ed (jpon, jpoe), STAT=ierr) ; CALL chk_allo (ierr, 'yo_ed') |
---|
| 157 | ALLOCATE (xa_ed (jpan, jpae), STAT=ierr) ; CALL chk_allo (ierr, 'xa_ed') |
---|
| 158 | ALLOCATE (ya_ed (jpan, jpae), STAT=ierr) ; CALL chk_allo (ierr, 'ya_ed') |
---|
| 159 | ! |
---|
| 160 | ALLOCATE (o2amask (jpan), STAT=ierr) ; CALL chk_allo (ierr, 'o2amask') |
---|
| 161 | ALLOCATE (a2omask (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'a2omask') |
---|
| 162 | ALLOCATE (o2afull (jpan), STAT=ierr) ; CALL chk_allo (ierr, 'o2afull') |
---|
| 163 | ALLOCATE (a2ofull (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'a2ofull') |
---|
| 164 | ALLOCATE (o2amask_i_int (jpan), STAT=ierr) ; CALL chk_allo (ierr, 'o2amask_i_int') |
---|
| 165 | ALLOCATE (o2amask_i_ext (jpan), STAT=ierr) ; CALL chk_allo (ierr, 'o2amask_i_ext') |
---|
| 166 | ALLOCATE (a2omask_i_int (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'a2omask_i_int') |
---|
| 167 | ALLOCATE (a2omask_i_ext (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'a2omask_i_ext') |
---|
| 168 | ! |
---|
| 169 | ! ---------------------------------------------------------------------------- |
---|
| 170 | ALLOCATE (m2ai (0:jpan), STAT=ierr) ; CALL chk_allo (ierr, 'm2ai') |
---|
| 171 | ALLOCATE (m2aj (0:jpan), STAT=ierr) ; CALL chk_allo (ierr, 'm2aj') |
---|
| 172 | ALLOCATE (mai (0:jpan), STAT=ierr) ; CALL chk_allo (ierr, 'mai ') |
---|
| 173 | ALLOCATE (maj (0:jpan), STAT=ierr) ; CALL chk_allo (ierr, 'maj ') |
---|
| 174 | m2ai (0) = 0_il ; m2aj (0) = 0_il |
---|
| 175 | DO ja = 1, jpan |
---|
| 176 | jai = MOD (ja - 1_il, jpai) + 1_il |
---|
| 177 | jaj = (ja - 1_il) / jpai + 1_il |
---|
| 178 | m2ai (ja) = jai |
---|
| 179 | m2aj (ja) = jaj |
---|
| 180 | mai (ja) = jai |
---|
| 181 | maj (ja) = MAX (1_il, MIN (jaj, jpaj)) |
---|
| 182 | IF (la_pole) THEN |
---|
| 183 | IF (jai == -1_il ) mai (ja) = jpai-1_il |
---|
| 184 | IF (jai == 0_il ) mai (ja) = jpai |
---|
| 185 | IF (jai == jpai+1_il) mai (ja) = 1_il |
---|
| 186 | IF (jai == jpai+2_il) mai (ja) = 2_il |
---|
| 187 | END IF |
---|
| 188 | END DO |
---|
| 189 | ! ---------------------------------------------------------------------------- |
---|
| 190 | ALLOCATE (m2oi (0:jpon), STAT=ierr) ; CALL chk_allo (ierr, 'm2oi') |
---|
| 191 | ALLOCATE (m2oj (0:jpon), STAT=ierr) ; CALL chk_allo (ierr, 'm2oj') |
---|
| 192 | ALLOCATE (moi (0:jpon), STAT=ierr) ; CALL chk_allo (ierr, 'moi ') |
---|
| 193 | ALLOCATE (moj (0:jpon), STAT=ierr) ; CALL chk_allo (ierr, 'moj ') |
---|
| 194 | m2oi (0) = 0_il ; m2oj (0) = 0_il |
---|
| 195 | moi (0) = 0_il ; moj (0) = 0_il |
---|
| 196 | DO jo = 1, jpon |
---|
| 197 | joi = MOD (jo - 1_il, jpoi) + 1_il |
---|
| 198 | joj = (jo - 1_il) / jpoi + 1_il |
---|
| 199 | m2oi (jo) = joi |
---|
| 200 | m2oj (jo) = joj |
---|
| 201 | moi (jo) = joi |
---|
| 202 | moj (jo) = MAX (1_il, MIN (joj, jpoj)) |
---|
| 203 | IF (noperio == 1 .OR. noperio == 4 .OR. noperio == -4_il) THEN |
---|
| 204 | IF (joi == -1_il ) moi (jo) = jpoi-3_il |
---|
| 205 | IF (joi == 0_il ) moi (jo) = jpoi-2_il |
---|
| 206 | IF (joi == 1_il ) moi (jo) = jpoi-1_il |
---|
| 207 | IF (joi == jpoi ) moi (jo) = 2_il |
---|
| 208 | IF (joi == jpoi+1_il) moi (jo) = 3_il |
---|
| 209 | IF (joi == jpoi+2_il) moi (jo) = 4_il |
---|
| 210 | ENDIF |
---|
| 211 | END DO |
---|
| 212 | ! ---------------------------------------------------------------------------- |
---|
| 213 | ALLOCATE (m1a (jpai, jpaj), STAT=ierr) ; CALL chk_allo (ierr, 'm1a ') |
---|
| 214 | ALLOCATE (m1ar (jpai, jpaj), STAT=ierr) ; CALL chk_allo (ierr, 'm1ar') |
---|
| 215 | DO jaj = 1, jpaj |
---|
| 216 | DO jai = 1, jpai |
---|
| 217 | m1a (jai, jaj) = jai + (jaj - 1_il) * jpai |
---|
| 218 | END DO |
---|
| 219 | END DO |
---|
| 220 | DO jaj = 1, jpaj |
---|
| 221 | DO jai = 1, jpai |
---|
| 222 | ja = m1a (jai, jaj) |
---|
| 223 | m1a (jai, jaj) = m1a (mai (ja), maj (ja)) |
---|
| 224 | END DO |
---|
| 225 | END DO |
---|
| 226 | ! ---------------------------------------------------------------------------- |
---|
| 227 | ALLOCATE (m1o (jpoi, jpoj), STAT=ierr) ; CALL chk_allo (ierr, 'm1o ') |
---|
| 228 | ALLOCATE (m1or (jpoi, jpoj), STAT=ierr) ; CALL chk_allo (ierr, 'm1or') |
---|
| 229 | DO joj = 1, jpoj |
---|
| 230 | DO joi = 1, jpoi |
---|
| 231 | m1o (joi, joj) = joi + (joj - 1_il) * jpoi |
---|
| 232 | END DO |
---|
| 233 | END DO |
---|
| 234 | DO joj = 1, jpoj |
---|
| 235 | DO joi = 1, jpoi |
---|
| 236 | jo = m1o (joi, joj) |
---|
| 237 | m1or (joi, joj) = m1o (moi (jo), moj (jo)) |
---|
| 238 | END DO |
---|
| 239 | END DO |
---|
| 240 | ! ---------------------------------------------------------------------------- |
---|
| 241 | |
---|
| 242 | !-$$ WRITE (nout,*) 'mai' |
---|
| 243 | !-$$ CALL prihin ( RESHAPE(mai (1:jpan), (/jpai, jpaj/)), kscale=3 ) |
---|
| 244 | !-$$ WRITE (nout,*) 'maj' |
---|
| 245 | !-$$ CALL prihin ( RESHAPE(maj (1:jpan), (/jpai, jpaj/)), kscale=3 ) |
---|
| 246 | !-$$ WRITE (nout,*) 'm2ai' |
---|
| 247 | !-$$ CALL prihin ( RESHAPE(m2ai(1:jpan), (/jpai, jpaj/)), kscale=3 ) |
---|
| 248 | !-$$ WRITE (nout,*) 'm2aj' |
---|
| 249 | !-$$ CALL prihin ( RESHAPE(m2aj(1:jpan), (/jpai, jpaj/)), kscale=3 ) |
---|
| 250 | !-$$ WRITE (nout,*) 'm1a' |
---|
| 251 | !-$$ CALL prihin (m1a , kscale=5) |
---|
| 252 | !-$$ WRITE (nout,*) 'm1ar' |
---|
| 253 | !-$$ CALL prihin (m1ar, kscale=5) |
---|
| 254 | !-$$ STOP |
---|
| 255 | |
---|
| 256 | END SUBROUTINE alloc_modeles |
---|
| 257 | END MODULE modeles |
---|