[3326] | 1 | ! -*- Mode: f90 -*- |
---|
| 2 | MODULE mod_wri_wei |
---|
| 3 | !> Set of routine to write weights and adresses |
---|
| 4 | USE modeles |
---|
| 5 | USE formula |
---|
| 6 | USE fliocom |
---|
| 7 | USE errioipsl |
---|
| 8 | |
---|
| 9 | LOGICAL :: l_nor2sou |
---|
| 10 | |
---|
| 11 | INTERFACE atm_reshape |
---|
| 12 | MODULE PROCEDURE atm_reshape_2d_r, atm_reshape_3d_r, atm_reshape_2d_i |
---|
| 13 | END INTERFACE atm_reshape |
---|
| 14 | |
---|
| 15 | CONTAINS |
---|
| 16 | |
---|
| 17 | FUNCTION atm_reshape_2d_r ( ptab ) |
---|
| 18 | IMPLICIT NONE |
---|
| 19 | REAL (kind=rl), DIMENSION (jpai, jpaj) :: atm_reshape_2d_r |
---|
| 20 | REAL (kind=rl), INTENT (in), DIMENSION (jpan) :: ptab |
---|
| 21 | INTEGER :: jai, jaj, jan, jaj_rev |
---|
| 22 | |
---|
| 23 | DO jaj = 1, jpaj |
---|
| 24 | IF (l_nor2sou) THEN |
---|
| 25 | jaj_rev = jpaj - jaj + 1 |
---|
| 26 | ELSE |
---|
| 27 | jaj_rev = jaj |
---|
| 28 | END IF |
---|
| 29 | DO jai = 1, jpai |
---|
| 30 | jan = jai + jpai * ( jaj_rev - 1) |
---|
| 31 | atm_reshape_2d_r (jai, jaj) = ptab (jan) |
---|
| 32 | END DO |
---|
| 33 | END DO |
---|
| 34 | END FUNCTION atm_reshape_2d_r |
---|
| 35 | |
---|
| 36 | FUNCTION atm_reshape_3d_r ( ptab ) |
---|
| 37 | IMPLICIT NONE |
---|
| 38 | REAL (kind=rl), DIMENSION (jpai, jpaj, jpae) :: atm_reshape_3d_r |
---|
| 39 | REAL (kind=rl), INTENT (in), DIMENSION (jpan, jpae) :: ptab |
---|
| 40 | INTEGER :: jai, jaj, jan, jaj_rev |
---|
| 41 | |
---|
| 42 | DO jaj = 1, jpaj |
---|
| 43 | IF (l_nor2sou) THEN |
---|
| 44 | jaj_rev = jpaj - jaj + 1 |
---|
| 45 | ELSE |
---|
| 46 | jaj_rev = jaj |
---|
| 47 | END IF |
---|
| 48 | DO jai = 1, jpai |
---|
| 49 | jan = jai + jpai * ( jaj_rev - 1) |
---|
| 50 | atm_reshape_3d_r (jai, jaj, :) = ptab (jan, :) |
---|
| 51 | END DO |
---|
| 52 | END DO |
---|
| 53 | END FUNCTION atm_reshape_3d_r |
---|
| 54 | |
---|
| 55 | FUNCTION atm_reshape_2d_i ( ktab ) |
---|
| 56 | IMPLICIT NONE |
---|
| 57 | INTEGER, DIMENSION (jpai, jpaj) :: atm_reshape_2d_i |
---|
| 58 | INTEGER, INTENT (in), DIMENSION (jpan) :: ktab |
---|
| 59 | INTEGER :: jai, jaj, jan, jaj_rev |
---|
| 60 | |
---|
| 61 | DO jaj = 1, jpaj |
---|
| 62 | IF (l_nor2sou) THEN |
---|
| 63 | jaj_rev = jpaj - jaj + 1 |
---|
| 64 | ELSE |
---|
| 65 | jaj_rev = jaj |
---|
| 66 | END IF |
---|
| 67 | DO jai = 1, jpai |
---|
| 68 | jan = jai + jpai * ( jaj_rev - 1) |
---|
| 69 | atm_reshape_2d_i (jai, jaj) = ktab (jan) |
---|
| 70 | END DO |
---|
| 71 | END DO |
---|
| 72 | END FUNCTION atm_reshape_2d_i |
---|
| 73 | |
---|
| 74 | SUBROUTINE wri_weights_o2a (cldiag_o2a, clw_o2a, clw_o2a_mct, clnum, l_fulldiag, lo_src_grid_frac, lo_dst_grid_frac) |
---|
| 75 | !> Write ocean -> atmosphere weights and adresses |
---|
| 76 | IMPLICIT NONE |
---|
| 77 | !! |
---|
| 78 | CHARACTER (LEN=1), INTENT (in) :: clnum |
---|
| 79 | CHARACTER (LEN=*), INTENT (in) :: cldiag_o2a, clw_o2a, clw_o2a_mct |
---|
| 80 | LOGICAL, INTENT (in), OPTIONAL :: l_fulldiag, lo_src_grid_frac, lo_dst_grid_frac |
---|
| 81 | INTEGER (KIND=il) :: nco2a, ierr, num_links, num_wgts |
---|
| 82 | INTEGER (KIND=il) :: il_ncid |
---|
| 83 | INTEGER (KIND=il) :: jai, jaj, ja, jo, j_link |
---|
| 84 | INTEGER (KIND=il) :: jn, jw, i_var, i_stat, isize_max, isize, ideb, ifin, ja_deb, ja_fin, ja_inc |
---|
| 85 | LOGICAL :: l_fd, l_src_grid_frac, l_dst_grid_frac |
---|
| 86 | CHARACTER (len=180) :: c_date, c_time, c_zone, c_tmp |
---|
| 87 | !! |
---|
| 88 | REAL (kind=rl), DIMENSION (:,:,:), ALLOCATABLE :: w_3d |
---|
| 89 | INTEGER (kind=il), DIMENSION (:,:,:), ALLOCATABLE :: k_3d |
---|
| 90 | !! |
---|
| 91 | REAL (kind=rl), DIMENSION (:,:), ALLOCATABLE :: w_mct |
---|
| 92 | INTEGER (kind=il), DIMENSION (:) , ALLOCATABLE :: k_src, k_dst |
---|
| 93 | ! |
---|
| 94 | l_fd = .TRUE. |
---|
| 95 | IF (PRESENT (l_fulldiag)) THEN |
---|
| 96 | l_fd = l_fulldiag |
---|
| 97 | ELSE |
---|
| 98 | !! Estimation de la taille des variables, limitation si > 2GB |
---|
| 99 | i_var = jpoi * jpoj * jmo2a |
---|
| 100 | IF ( i_var >= 2E9_il ) l_fd = .TRUE. |
---|
| 101 | END IF |
---|
| 102 | |
---|
| 103 | IF ( PRESENT (lo_src_grid_frac) ) THEN |
---|
| 104 | l_src_grid_frac = lo_src_grid_frac |
---|
| 105 | ELSE |
---|
| 106 | l_src_grid_frac = .TRUE. |
---|
| 107 | END IF |
---|
| 108 | |
---|
| 109 | IF ( PRESENT (lo_dst_grid_frac) ) THEN |
---|
| 110 | l_dst_grid_frac = lo_dst_grid_frac |
---|
| 111 | ELSE |
---|
| 112 | l_dst_grid_frac = .TRUE. |
---|
| 113 | END IF |
---|
| 114 | |
---|
| 115 | !! |
---|
| 116 | !! Dataset ocean --> atmosphere |
---|
| 117 | !! |
---|
| 118 | clweight = "WEIGHTS" // clnum ; cladress = "ADRESSE" // clnum |
---|
| 119 | WRITE (unit = nout, fmt = *) " oce -> atm ", cladress, " ", clweight, " Neighbors : ", jmo2a |
---|
| 120 | IF (c_oasis == '2.2' ) THEN |
---|
| 121 | IF (l_wei_i4 .OR. l_wei_i8) WRITE (unit = nout, fmt = *) 'Ecriture o2a, fichiers binaires IEEE' |
---|
| 122 | IF (l_wei_i4) THEN |
---|
| 123 | WRITE (UNIT = nwei4o2a) cladress |
---|
| 124 | WRITE (UNIT = nwei4o2a) INT (ko2a (1_il:jmo2a, 1_il:jpan), KIND=i_4 ) |
---|
| 125 | WRITE (UNIT = nwei4o2a) clweight |
---|
| 126 | WRITE (UNIT = nwei4o2a) REAL (wo2a (1_il:jmo2a, 1_il:jpan), KIND=rk_out ) |
---|
| 127 | ENDIF |
---|
| 128 | IF (l_wei_i8) THEN |
---|
| 129 | WRITE (UNIT = nwei8o2a) cladress |
---|
| 130 | WRITE (UNIT = nwei8o2a) INT (ko2a (1_il:jmo2a, 1_il:jpan), KIND=i_8 ) |
---|
| 131 | WRITE (UNIT = nwei8o2a) clweight |
---|
| 132 | WRITE (UNIT = nwei8o2a) REAL (wo2a (1_il:jmo2a, 1_il:jpan), KIND=rk_out ) |
---|
| 133 | ENDIF |
---|
| 134 | ENDIF |
---|
| 135 | IF (l_wei_i4) THEN |
---|
| 136 | WRITE (UNIT = nout, FMT = *) 'Ecriture OCEMASK i4r8 : non masque' |
---|
| 137 | WRITE (UNIT = nwei4o2a) 'OCEMASK'//clnum |
---|
| 138 | WRITE (UNIT = nout, FMT = *) 'Ecriture OCEMASK i4r8 : masque' |
---|
| 139 | WRITE (UNIT = nwei4o2a) REAL (o2amask (1_il:jpan), KIND=rk_out ) |
---|
| 140 | END IF |
---|
| 141 | IF (l_wei_i8) THEN |
---|
| 142 | WRITE (UNIT = nout, FMT = *) 'Ecriture OCEMASK i8r8 : non masque' |
---|
| 143 | WRITE (UNIT = nwei8o2a) 'OCEMASK'//clnum |
---|
| 144 | WRITE (UNIT = nout, FMT = *) 'Ecriture i8r8 : masque' |
---|
| 145 | WRITE (UNIT = nwei8o2a) REAL (o2amask (1_il:jpan), KIND=rk_out ) |
---|
| 146 | WRITE (UNIT = nout, FMT = *) 'Ecriture en binaire IEEE : fini ' |
---|
| 147 | ENDIF |
---|
| 148 | !! |
---|
| 149 | !! Output diagnostics in NetCDF file |
---|
| 150 | !! |
---|
| 151 | !CALL ipsldbg (new_status=.TRUE. ) |
---|
| 152 | WRITE (unit = nout, fmt = *) 'Ecriture o2a, diagnostiques ', TRIM(cldiag_o2a) |
---|
| 153 | WRITE (unit = nout, fmt = *) 'Retournement nord/sud des champs : ', xalatt(1), xalatt(jpan), TRIM(o2a_orien) |
---|
| 154 | |
---|
| 155 | IF ( TRIM(o2a_orien) .EQ. "nord_en_bas") THEN |
---|
| 156 | WRITE (unit = nout, fmt = *) "Cas nord_en_bas" |
---|
| 157 | IF ( xalatt(1) .GT. xalatt(jpan) ) THEN |
---|
| 158 | l_nor2sou = .FALSE. |
---|
| 159 | ja_deb = 1 ; ja_fin = jpaj ; ja_inc = 1 |
---|
| 160 | ELSE |
---|
| 161 | l_nor2sou = .TRUE. |
---|
| 162 | ja_deb = jpaj ; ja_fin = 1 ; ja_inc = -1 |
---|
| 163 | END IF |
---|
| 164 | ELSE IF ( TRIM(o2a_orien) .EQ. "nord_en_haut") THEN |
---|
| 165 | WRITE (unit = nout, fmt = *) "Cas nord_en_haut" |
---|
| 166 | IF ( xalatt(1) .GT. xalatt(jpan) ) THEN |
---|
| 167 | l_nor2sou = .TRUE. |
---|
| 168 | ja_deb = jpaj ; ja_fin = 1 ; ja_inc = -1 |
---|
| 169 | ELSE |
---|
| 170 | l_nor2sou = .FALSE. |
---|
| 171 | ja_deb = 1 ; ja_fin = jpaj ; ja_inc = 1 |
---|
| 172 | END IF |
---|
| 173 | ELSE |
---|
| 174 | WRITE (unit = nout, fmt = *) "Cas inconnu" |
---|
| 175 | l_nor2sou = .FALSE. |
---|
| 176 | ja_deb = 1 ; ja_fin = jpaj ; ja_inc = 1 |
---|
| 177 | END IF |
---|
| 178 | |
---|
| 179 | WRITE (unit = nout, fmt = *) 'Retournement nord/sud des champs : ', l_nor2sou, ja_deb, ja_fin, ja_inc |
---|
| 180 | |
---|
| 181 | CALL fliocrfd (TRIM(cldiag_o2a) // TRIM(c_suffix), (/'x ', 'y ', 'n ', 'edge'/), (/jpai, jpaj, jmo2a, jpae /),& |
---|
| 182 | & nco2a, mode=c_FlioMode) |
---|
| 183 | CALL fliopstc (nco2a, & |
---|
| 184 | & x_axis_2d = atm_reshape(xalont), & |
---|
| 185 | & y_axis_2d = atm_reshape(xalatt) ) |
---|
| 186 | CALL flioputa (nco2a, '?', 'Comment', TRIM(c_comment) ) |
---|
| 187 | CALL fliodefv (nco2a, 'Weights_Max'//clnum, (/1_il,2_il/), v_t=flio_r4, standard_name='Oce -> Atm max weights') |
---|
| 188 | CALL flioputa (nco2a, 'Weights_Max'//clnum, 'missing_value', 0.0_rl) |
---|
| 189 | CALL fliodefv (nco2a, 'Neighbors'//clnum , (/1_il,2_il/), v_t=flio_i4, standard_name='Oce -> Atm Neighbors') |
---|
| 190 | CALL flioputa (nco2a, 'Neighbors'//clnum, 'missing_value', 0.0_rl) |
---|
| 191 | CALL fliodefv (nco2a, 'Weights_Sum'//clnum, (/1_il,2_il/), v_t=flio_r4, standard_name='Oce -> Atm sum weights') |
---|
| 192 | CALL flioputa (nco2a, 'Weights_Sum'//clnum, 'missing_value', 0.0_rl) |
---|
| 193 | CALL fliodefv (nco2a, 'Mask', (/1_il,2_il/), v_t=flio_i4, standard_name='Oce -> Atm mask') |
---|
| 194 | CALL flioputa (nco2a, 'Mask', 'missing_value', 0.0_rl) |
---|
| 195 | CALL fliodefv (nco2a, 'OceMask', (/1_il,2_il/), v_t=flio_r4, standard_name='Oce ->Atm OceMask') |
---|
| 196 | CALL flioputa (nco2a, 'OceMask', 'missing_value', 0.0_rl) |
---|
| 197 | CALL fliodefv (nco2a, 'OceMask_int', (/1_il,2_il/), v_t=flio_i4, standard_name='Oce ->Atm OceMask') |
---|
| 198 | CALL fliodefv (nco2a, 'OceMask_ext', (/1_il,2_il/), v_t=flio_i4, standard_name='Oce ->Atm OceMask') |
---|
| 199 | CALL fliodefv (nco2a, 'LonEdge', (/1,2,4/), v_t=flio_r4) |
---|
| 200 | CALL flioputa (nco2a, 'LonEdge', 'missing_value', 0.0_rl) |
---|
| 201 | CALL fliodefv (nco2a, 'LatEdge', (/1,2,4/), v_t=flio_r4) |
---|
| 202 | CALL flioputa (nco2a, 'LatEdge', 'missing_value', 0.0_rl) |
---|
| 203 | IF (l_fd) THEN |
---|
| 204 | WRITE (nout,*) 'Fichier Diagnostics ' |
---|
| 205 | CALL fliodefv (nco2a, 'Weights'//clnum, (/1,2,3/), v_t=flio_r4, standard_name='Oce -> Atm Weights') |
---|
| 206 | CALL flioputa (nco2a, 'Weights'//clnum, 'missing_value', 0.0_rl) |
---|
| 207 | CALL fliodefv (nco2a, 'Adresses'//clnum,(/1,2,3/), v_t=flio_i4, standard_name='Oce -> Atm Adresses') |
---|
| 208 | CALL flioputa (nco2a, 'Adresses'//clnum, 'missing_value', 0.0_rl) |
---|
| 209 | CALL fliodefv (nco2a, 'Index_I'//clnum, (/1,2,3/), v_t=flio_i4 ) |
---|
| 210 | CALL flioputa (nco2a, 'Index_I'//clnum, 'missing_value', 0.0_rl) |
---|
| 211 | CALL fliodefv (nco2a, 'Index_J'//clnum, (/1_il,2_il,3_il/), v_t=flio_i4 ) |
---|
| 212 | CALL flioputa (nco2a, 'Index_J'//clnum, 'missing_value', 0.0_rl) |
---|
| 213 | ELSE |
---|
| 214 | WRITE (nout,*) 'Pas de fichier diagnostics ' |
---|
| 215 | END IF |
---|
| 216 | CALL fliodefv (nco2a, 'MaskPer', (/1_il,2_il/), v_t=flio_i4 ) |
---|
| 217 | CALL flioputa (nco2a, 'MaskPer', 'missing_value', 0.0_rl) |
---|
| 218 | CALL fliodefv (nco2a, 'Surface', (/1,2/)) |
---|
| 219 | CALL flioputa (nco2a, 'Surface', 'missing_value', 0.0_rl) |
---|
| 220 | CALL fliodefv (nco2a, 'SurfacePol', (/1,2/)) |
---|
| 221 | CALL flioputa (nco2a, 'SurfacePol', 'missing_value', 0.0_rl) |
---|
| 222 | !! |
---|
| 223 | CALL flioputv (nco2a, 'Weights_Max'//clnum, atm_reshape (MAXVAL(wo2a,DIM=1)) ) |
---|
| 224 | CALL flioputv (nco2a, 'Neighbors'//clnum, atm_reshape (MAX(0_il, nva)) ) |
---|
| 225 | CALL flioputv (nco2a, 'Weights_Sum'//clnum, atm_reshape (SUM (wo2a,DIM=1)) ) |
---|
| 226 | CALL flioputv (nco2a, 'Mask', atm_reshape (1_il-iamskt) ) |
---|
| 227 | CALL flioputv (nco2a, 'OceMask', atm_reshape (o2amask) ) |
---|
| 228 | CALL flioputv (nco2a, 'OceMask_int', atm_reshape (o2amask_i_int) ) |
---|
| 229 | CALL flioputv (nco2a, 'OceMask_ext', atm_reshape (o2amask_i_ext) ) |
---|
| 230 | CALL flioputv (nco2a, 'LonEdge', atm_reshape (xa_ed) ) |
---|
| 231 | CALL flioputv (nco2a, 'LatEdge', atm_reshape (ya_ed) ) |
---|
| 232 | CALL flioputv (nco2a, 'Surface', atm_reshape (xasrft) ) |
---|
| 233 | CALL flioputv (nco2a, 'SurfacePol', atm_reshape (xasrft_pol) ) |
---|
| 234 | |
---|
| 235 | IF (l_fd) THEN |
---|
| 236 | ALLOCATE (w_3d(jpai, jpaj, jmo2a), STAT=ierr) |
---|
| 237 | CALL chk_allo (ierr, 'w_3d(jpai,jpaj,jmo2a)', lreset=.TRUE., crout='wri_wei_o2a') |
---|
| 238 | ALLOCATE (k_3d(jpai, jpaj, jmo2a), STAT=ierr) |
---|
| 239 | CALL chk_allo (ierr, 'k_3d(jpai,jpaj,jmo2a)') |
---|
| 240 | |
---|
| 241 | DO jn = 1_il, jmo2a |
---|
| 242 | DO jaj = 1_il, jpaj |
---|
| 243 | DO jai = 1_il, jpai |
---|
| 244 | w_3d (jai, jaj, jn) = REAL(wo2a (jn, m1a(jai, jaj)), KIND=rl) |
---|
| 245 | k_3d (jai, jaj, jn) = INT (ko2a (jn, m1a(jai, jaj)), KIND=il) |
---|
| 246 | END DO |
---|
| 247 | END DO |
---|
| 248 | END DO |
---|
| 249 | IF (limit_stack) THEN |
---|
| 250 | DO jn = 1_il, jmo2a |
---|
| 251 | !WRITE (UNIT=nout,FMT='(1I4)') jn |
---|
| 252 | CALL flioputv (nco2a, 'Weights'//clnum, w_3d(:,ja_deb:ja_fin:ja_inc,jn), start=(/1_il,1_il,jn/) ) |
---|
| 253 | END DO |
---|
| 254 | ELSE |
---|
| 255 | CALL flioputv (nco2a, 'Weights'//clnum, w_3d(:,ja_deb:ja_fin:ja_inc,:) ) |
---|
| 256 | ENDIF |
---|
| 257 | !! |
---|
| 258 | IF (limit_stack) THEN |
---|
| 259 | DO jn = 1_il, jmo2a |
---|
| 260 | !WRITE (UNIT=nout,FMT='(1I4)') jn |
---|
| 261 | CALL flioputv (nco2a, 'Adresses'//clnum, k_3d(:,ja_deb:ja_fin:ja_inc,jn), start=(/1_il,1_il,jn/) ) |
---|
| 262 | ENDDO |
---|
| 263 | ELSE |
---|
| 264 | CALL flioputv (nco2a, 'Adresses'//clnum, k_3d(:,ja_deb:ja_fin:ja_inc,:)) |
---|
| 265 | ENDIF |
---|
| 266 | DEALLOCATE (w_3d) |
---|
| 267 | ! |
---|
| 268 | k_3d = 0_il |
---|
| 269 | DO jn = 1_il, jmo2a |
---|
| 270 | DO jaj = 1_il, jpaj |
---|
| 271 | DO jai = 1_il, jpai |
---|
| 272 | k_3d (jai, jaj, jn) = m2oi(ko2a(jn, m1a(jai, jaj))) |
---|
| 273 | END DO |
---|
| 274 | END DO |
---|
| 275 | END DO |
---|
| 276 | IF (limit_stack) THEN |
---|
| 277 | DO jn = 1_il, jmo2a |
---|
| 278 | !WRITE (UNIT=nout,FMT='(1I4)') jn |
---|
| 279 | CALL flioputv (nco2a, 'Index_I'//clnum, k_3d(:,ja_deb:ja_fin:ja_inc,jn), start=(/1_il,1_il,jn/) ) |
---|
| 280 | ENDDO |
---|
| 281 | ELSE |
---|
| 282 | CALL flioputv (nco2a, 'Index_I'//clnum, k_3d(:,ja_deb:ja_fin:ja_inc,1:jmo2a)) |
---|
| 283 | ENDIF |
---|
| 284 | k_3d = 0_il |
---|
| 285 | DO jn = 1_il, jmo2a |
---|
| 286 | DO jaj = 1_il, jpaj |
---|
| 287 | DO jai = 1_il, jpai |
---|
| 288 | k_3d (jai, jaj, jn) = m2oj(ko2a(jn, m1a(jai, jaj))) |
---|
| 289 | END DO |
---|
| 290 | END DO |
---|
| 291 | END DO |
---|
| 292 | IF (limit_stack) THEN |
---|
| 293 | DO jn = 1_il, jmo2a |
---|
| 294 | !WRITE (UNIT=nout,FMT='(1I4)') jn |
---|
| 295 | CALL flioputv (nco2a, 'Index_J'//clnum, k_3d(:,ja_deb:ja_fin:ja_inc,jn), start=(/1_il,1_il,jn/) ) |
---|
| 296 | ENDDO |
---|
| 297 | ELSE |
---|
| 298 | CALL flioputv (nco2a, 'Index_J'//clnum, k_3d(:,ja_deb:ja_fin:ja_inc,1:jmo2a)) |
---|
| 299 | ENDIF |
---|
| 300 | DEALLOCATE (k_3d) |
---|
| 301 | ENDIF |
---|
| 302 | !! |
---|
| 303 | WRITE (unit=nout,fmt=*) 'Fin ecriture diagnostiques o2a ' |
---|
| 304 | CALL flioclo (nco2a) |
---|
| 305 | !! |
---|
| 306 | IF ( l_wei_oasis_3 ) THEN |
---|
| 307 | !! Ecriture des poids au format NetCDF de OASIS, format OASIS 3 |
---|
| 308 | !! O -> A |
---|
| 309 | WRITE (unit=nout,fmt=*) 'Ecriture poids o2a NetCDF OASIS 3' |
---|
| 310 | CALL fliocrfd (TRIM(clw_o2a) // TRIM(c_suffix) // '.nc' , (/'jmo2a', 'jpan '/), (/jmo2a, jpan/), il_ncid, mode=c_FlioMode ) |
---|
| 311 | CALL flioputa (il_ncid, '?', 'Comment', TRIM(c_comment) ) |
---|
| 312 | CALL fliodefv (il_ncid, 'WEIGHTS'//clnum, (/1, 2/), v_t=flio_r ) |
---|
| 313 | CALL fliodefv (il_ncid, 'ADRESSE'//clnum, (/1, 2/), v_t=flio_i ) |
---|
| 314 | ! Write WEIGHTS |
---|
| 315 | IF (limit_stack) THEN |
---|
| 316 | DO jn = 1, jmo2a |
---|
| 317 | !WRITE (UNIT=nout,FMT='(1I4)') jn |
---|
| 318 | CALL flioputv (il_ncid, 'WEIGHTS'//clnum, wo2a(jn,:), start=(/jn, 1/), count=(/1,jpan/) ) |
---|
| 319 | END DO |
---|
| 320 | ELSE |
---|
| 321 | CALL flioputv (il_ncid, 'WEIGHTS'//clnum, wo2a(1:jmo2a,:)) |
---|
| 322 | ENDIF |
---|
| 323 | ! Write ADRESSE |
---|
| 324 | IF (limit_stack) THEN |
---|
| 325 | DO jn = 1, jmo2a |
---|
| 326 | !WRITE (UNIT=nout,FMT='(1I4)') jn |
---|
| 327 | CALL flioputv (il_ncid, 'ADRESSE'//clnum, ko2a(jn,:), start=(/jn, 1/), count=(/1,jpan/) ) |
---|
| 328 | END DO |
---|
| 329 | ELSE |
---|
| 330 | CALL flioputv (il_ncid, 'ADRESSE'//clnum, ko2a(1:jmo2a,:)) |
---|
| 331 | ENDIF |
---|
| 332 | WRITE (unit=nout, fmt=*) 'Fin ecriture poids o2a NetCDF' |
---|
| 333 | CALL flioclo (il_ncid) |
---|
| 334 | !! |
---|
| 335 | WRITE (unit=nout,fmt=*) 'Ecriture poids o2a NetCDF, format OASIS MCT' |
---|
| 336 | num_links = jpan * jmo2a |
---|
| 337 | num_wgts = 1 |
---|
| 338 | ALLOCATE (w_mct(num_wgts,num_links), STAT=ierr) |
---|
| 339 | CALL chk_allo (ierr, 'w_mct(num_wgts,num_links)', lreset=.TRUE., crout='wri_wei_o2a') |
---|
| 340 | ALLOCATE (k_src(num_links), STAT=ierr) |
---|
| 341 | CALL chk_allo (ierr, 'k_src(num_links)', lreset=.TRUE., crout='wri_wei_o2a') |
---|
| 342 | ALLOCATE (k_dst(num_links), STAT=ierr) |
---|
| 343 | CALL chk_allo (ierr, 'k_dst(num_links)', lreset=.TRUE., crout='wri_wei_o2a') |
---|
| 344 | ! |
---|
| 345 | j_link = 0 |
---|
| 346 | DO ja = 1, jpan |
---|
| 347 | DO jn = 1, jmo2a |
---|
| 348 | IF ( ko2a (jn, ja) /= 0 ) THEN |
---|
| 349 | j_link = j_link + 1 |
---|
| 350 | k_dst (j_link) = ja |
---|
| 351 | k_src (j_link) = ko2a (jn, ja) |
---|
| 352 | w_mct (1,j_link) = wo2a (jn, ja) |
---|
| 353 | END IF |
---|
| 354 | END DO |
---|
| 355 | END DO |
---|
| 356 | num_links = j_link |
---|
| 357 | |
---|
| 358 | END IF |
---|
| 359 | |
---|
| 360 | IF ( l_wei_oasis_mct ) THEN |
---|
| 361 | !! Ecriture des poids au format NetCDF de OASIS, format OASIS MCT |
---|
| 362 | |
---|
| 363 | CALL fliocrfd (TRIM(clw_o2a_mct) // TRIM(c_suffix), & |
---|
| 364 | & (/'src_grid_size ', 'dst_grid_size ', 'src_grid_corners', 'dst_grid_corners' , & |
---|
| 365 | & 'src_grid_rank ', 'dst_grid_rank ', 'num_links ', 'num_wgts '/), & |
---|
| 366 | & (/ jpon , jpan , 4 , 4 , & |
---|
| 367 | & 2 , 2 , num_links , num_wgts /), & |
---|
| 368 | & il_ncid, mode=c_FlioMode) |
---|
| 369 | CALL flioputa (il_ncid, "?", "title" , TRIM(clw_o2a_mct) ) |
---|
| 370 | CALL flioputa (il_ncid, '?', 'Comment', TRIM(c_comment) ) |
---|
| 371 | CALL flioputa (il_ncid, "?", "normalization" , "none" ) |
---|
| 372 | CALL flioputa (il_ncid, "?", "map_method" , "Conservative Remapping" ) |
---|
| 373 | CALL DATE_AND_TIME (c_date, c_time, c_zone ) |
---|
| 374 | CALL flioputa (il_ncid, "?", "history" , "Created: "//c_date(1:4)//"-"//c_date(5:6)//"-"//c_date(7:8) & |
---|
| 375 | & //" "//c_time(1:2)//"h"//c_time(3:4)//" GMT"//TRIM(c_zone) ) |
---|
| 376 | CALL flioputa (il_ncid, "?", "conventions" , "SCRIP" ) |
---|
| 377 | CALL flioputa (il_ncid, "?", "method" , "MOSAIC" ) |
---|
| 378 | CALL flioputa (il_ncid, "?", "source_grid" , "curvilinear" ) |
---|
| 379 | CALL flioputa (il_ncid, "?", "dest_grid" , "curvilinear" ) |
---|
| 380 | CALL flioputa (il_ncid, "?", "Institution" , "IPSL" ) |
---|
| 381 | CALL flioputa (il_ncid, "?", "Model" , "IPSL CM6" ) |
---|
| 382 | CALL flioputa (il_ncid, "?", "Max_nei_num" , jmo2a ) |
---|
| 383 | CALL GET_ENVIRONMENT_VARIABLE ( NAME="HOSTNAME" , VALUE=c_tmp, TRIM_NAME=.TRUE., STATUS=i_stat) |
---|
| 384 | IF ( i_stat == 0 ) THEN |
---|
| 385 | CALL flioputa (il_ncid, "?", "HOSTNAME" , TRIM(c_tmp) ) |
---|
| 386 | ELSE |
---|
| 387 | WRITE (nout,*) 'Environment variable not found : $HOSTNAME' |
---|
| 388 | END IF |
---|
| 389 | CALL GET_ENVIRONMENT_VARIABLE ( NAME="LOGNAME" , VALUE=c_tmp, TRIM_NAME=.TRUE., STATUS=i_stat) |
---|
| 390 | IF ( i_stat == 0 ) THEN |
---|
| 391 | CALL flioputa (il_ncid, "?", "LOGNAME" , TRIM(c_tmp) ) |
---|
| 392 | ELSE |
---|
| 393 | WRITE (nout,*) 'Environment variable not found : $LOGNAME' |
---|
| 394 | END IF |
---|
| 395 | ! |
---|
| 396 | CALL fliodefv (il_ncid, 'src_grid_dims' , (/5/) , v_t=flio_i ) |
---|
| 397 | CALL fliodefv (il_ncid, 'dst_grid_dims' , (/6/) , v_t=flio_i ) |
---|
| 398 | CALL fliodefv (il_ncid, 'src_grid_center_lat', (/1/) , v_t=flio_r , units = "degrees_north" ) |
---|
| 399 | CALL fliodefv (il_ncid, 'src_grid_center_lon', (/1/) , v_t=flio_r , units = "degrees_east" ) |
---|
| 400 | CALL fliodefv (il_ncid, 'dst_grid_center_lat', (/2/) , v_t=flio_r , units = "degrees_north" ) |
---|
| 401 | CALL fliodefv (il_ncid, 'dst_grid_center_lon', (/2/) , v_t=flio_r , units = "degrees_east" ) |
---|
| 402 | CALL fliodefv (il_ncid, 'src_grid_corner_lat', (/3,1/), v_t=flio_r , units = "degrees_north" ) |
---|
| 403 | CALL fliodefv (il_ncid, 'src_grid_corner_lon', (/3,1/), v_t=flio_r , units = "degrees_east" ) |
---|
| 404 | CALL fliodefv (il_ncid, 'dst_grid_corner_lat', (/4,2/), v_t=flio_r , units = "degrees_north" ) |
---|
| 405 | CALL fliodefv (il_ncid, 'dst_grid_corner_lon', (/4,2/), v_t=flio_r , units = "degrees_east" ) |
---|
| 406 | CALL fliodefv (il_ncid, 'src_grid_imask' , (/1/) , v_t=flio_i , units = "unitless" ) |
---|
| 407 | CALL fliodefv (il_ncid, 'dst_grid_imask' , (/2/) , v_t=flio_i , units = "unitless" ) |
---|
| 408 | CALL fliodefv (il_ncid, 'src_grid_area' , (/1/) , v_t=flio_r , units = "m^2" ) |
---|
| 409 | CALL fliodefv (il_ncid, 'dst_grid_area' , (/2/) , v_t=flio_r , units = "m^2" ) |
---|
| 410 | CALL fliodefv (il_ncid, 'src_grid_frac' , (/1/) , v_t=flio_r , units = "unitless" ) |
---|
| 411 | CALL fliodefv (il_ncid, 'dst_grid_frac' , (/2/) , v_t=flio_r , units = "unitless" ) |
---|
| 412 | CALL fliodefv (il_ncid, 'dst_address' , (/7/) , v_t=flio_i ) |
---|
| 413 | CALL fliodefv (il_ncid, 'src_address' , (/7/) , v_t=flio_i ) |
---|
| 414 | CALL fliodefv (il_ncid, 'remap_matrix' , (/8,7/), v_t=flio_r ) |
---|
| 415 | ! |
---|
| 416 | CALL flioputa (il_ncid, 'src_grid_imask', 'land_value', 0) |
---|
| 417 | CALL flioputa (il_ncid, 'src_grid_imask', 'sea_value' , 1) |
---|
| 418 | CALL flioputa (il_ncid, 'dst_grid_imask', 'land_value', 0) |
---|
| 419 | CALL flioputa (il_ncid, 'dst_grid_imask', 'sea_value' , 1) |
---|
| 420 | ! |
---|
| 421 | CALL flioputv (il_ncid, 'src_grid_dims' , (/ jpoi, jpoj /) ) |
---|
| 422 | CALL flioputv (il_ncid, 'dst_grid_dims' , (/ jpai, jpaj /) ) |
---|
| 423 | CALL flioputv (il_ncid, 'src_grid_center_lat', xolatt ) |
---|
| 424 | CALL flioputv (il_ncid, 'src_grid_center_lon', lon_180(xolont)) |
---|
| 425 | CALL flioputv (il_ncid, 'dst_grid_center_lat', xalatt ) |
---|
| 426 | CALL flioputv (il_ncid, 'dst_grid_center_lon', lon_180(xalont)) |
---|
| 427 | |
---|
| 428 | CALL flioputv (il_ncid, 'src_grid_corner_lat', yo_ed (:,1) , start=(/1,1/), count=(/1,jpon/) ) |
---|
| 429 | CALL flioputv (il_ncid, 'src_grid_corner_lat', yo_ed (:,3) , start=(/2,1/), count=(/1,jpon/) ) |
---|
| 430 | CALL flioputv (il_ncid, 'src_grid_corner_lat', yo_ed (:,5) , start=(/3,1/), count=(/1,jpon/) ) |
---|
| 431 | CALL flioputv (il_ncid, 'src_grid_corner_lat', yo_ed (:,8) , start=(/4,1/), count=(/1,jpon/) ) |
---|
| 432 | CALL flioputv (il_ncid, 'src_grid_corner_lon', lon_180(xo_ed (:, 1)), start=(/1,1/), count=(/1,jpon/) ) |
---|
| 433 | CALL flioputv (il_ncid, 'src_grid_corner_lon', lon_180(xo_ed (:, 3)), start=(/2,1/), count=(/1,jpon/) ) |
---|
| 434 | CALL flioputv (il_ncid, 'src_grid_corner_lon', lon_180(xo_ed (:, 5)), start=(/3,1/), count=(/1,jpon/) ) |
---|
| 435 | CALL flioputv (il_ncid, 'src_grid_corner_lon', lon_180(xo_ed (:, 8)), start=(/4,1/), count=(/1,jpon/) ) |
---|
| 436 | |
---|
| 437 | CALL flioputv (il_ncid, 'dst_grid_corner_lat', ya_ed (:, 1) , start=(/1,1/), count=(/1,jpan/) ) |
---|
| 438 | CALL flioputv (il_ncid, 'dst_grid_corner_lat', ya_ed (:, 3) , start=(/2,1/), count=(/1,jpan/) ) |
---|
| 439 | CALL flioputv (il_ncid, 'dst_grid_corner_lat', ya_ed (:, 5) , start=(/3,1/), count=(/1,jpan/) ) |
---|
| 440 | CALL flioputv (il_ncid, 'dst_grid_corner_lat', ya_ed (:, 8) , start=(/4,1/), count=(/1,jpan/) ) |
---|
| 441 | CALL flioputv (il_ncid, 'dst_grid_corner_lon', lon_180(xa_ed (:, 1)), start=(/1,1/), count=(/1,jpan/) ) |
---|
| 442 | CALL flioputv (il_ncid, 'dst_grid_corner_lon', lon_180(xa_ed (:, 3)), start=(/2,1/), count=(/1,jpan/) ) |
---|
| 443 | CALL flioputv (il_ncid, 'dst_grid_corner_lon', lon_180(xa_ed (:, 5)), start=(/3,1/), count=(/1,jpan/) ) |
---|
| 444 | CALL flioputv (il_ncid, 'dst_grid_corner_lon', lon_180(xa_ed (:, 8)), start=(/4,1/), count=(/1,jpan/) ) |
---|
| 445 | |
---|
| 446 | CALL flioputv (il_ncid, 'src_grid_imask' , (1-iomskt)*(1-iomskp) ) |
---|
| 447 | CALL flioputv (il_ncid, 'dst_grid_imask' , 1-o2amask_i_int*(1-iomskp) ) |
---|
| 448 | CALL flioputv (il_ncid, 'src_grid_area' , xosrft ) |
---|
| 449 | CALL flioputv (il_ncid, 'dst_grid_area' , xasrft ) |
---|
| 450 | |
---|
| 451 | CALL flioputv (il_ncid, 'dst_grid_frac' , o2amask ) |
---|
| 452 | |
---|
| 453 | |
---|
| 454 | IF (l_src_grid_frac) THEN |
---|
| 455 | CALL flioputv (il_ncid, 'src_grid_frac' , REAL ((1-iomskt)*(1-iomskp),KIND=rl) ) |
---|
| 456 | ELSE |
---|
| 457 | CALL flioputv (il_ncid, 'src_grid_frac' , REAL (1-0*iomskt,KIND=rl) ) |
---|
| 458 | ENDIF |
---|
| 459 | IF (l_dst_grid_frac) THEN |
---|
| 460 | CALL flioputv (il_ncid, 'dst_grid_frac' , o2amask ) |
---|
| 461 | ELSE |
---|
| 462 | CALL flioputv (il_ncid, 'dst_grid_frac' , 1.0_rl+0.0_rl*o2amask ) |
---|
| 463 | END IF |
---|
| 464 | |
---|
| 465 | CALL flioputv (il_ncid, 'dst_address' , k_dst (1:num_links) ) |
---|
| 466 | CALL flioputv (il_ncid, 'src_address' , k_src (1:num_links) ) |
---|
| 467 | CALL flioputv (il_ncid, 'remap_matrix ' , w_mct (1:num_wgts,1:num_links) ) |
---|
| 468 | |
---|
| 469 | !! |
---|
| 470 | CALL flioclo (il_ncid) |
---|
| 471 | END IF |
---|
| 472 | |
---|
| 473 | RETURN |
---|
| 474 | |
---|
| 475 | END SUBROUTINE wri_weights_o2a |
---|
| 476 | !! |
---|
| 477 | SUBROUTINE wri_weights_a2o (cldiag_a2o, clw_a2o, clw_a2o_mct, clnum, l_fulldiag, lo_src_grid_frac, lo_dst_grid_frac, & |
---|
| 478 | co_omsk, co_amsk ) |
---|
| 479 | !> Write atmosphere -> ocean weights and adresses |
---|
| 480 | IMPLICIT NONE |
---|
| 481 | !! |
---|
| 482 | CHARACTER (len=1), INTENT (in) :: clnum |
---|
| 483 | CHARACTER (len=*) :: cldiag_a2o, clw_a2o, clw_a2o_mct |
---|
| 484 | LOGICAL, INTENT (in), OPTIONAL :: l_fulldiag, lo_src_grid_frac, lo_dst_grid_frac |
---|
| 485 | CHARACTER (len=*), INTENT (in), OPTIONAL :: co_omsk, co_amsk |
---|
| 486 | INTEGER (KIND=il) :: nca2o, ierr, num_links, num_wgts |
---|
| 487 | INTEGER (KIND=il) :: il_ncid |
---|
| 488 | INTEGER (KIND=il) :: joi, joj, ja, jo, j_link |
---|
| 489 | INTEGER (KIND=il) :: jn, jw, j1, j2, i_var, i_stat, isize_max, isize, ideb, ifin |
---|
| 490 | LOGICAL :: l_fd, l_src_grid_frac, l_dst_grid_frac |
---|
| 491 | CHARACTER (len=20) :: c_omsk, c_amsk |
---|
| 492 | CHARACTER (len=180) :: c_date, c_time, c_zone, c_tmp |
---|
| 493 | !! |
---|
| 494 | REAL (KIND=rl), DIMENSION (:,:,:), ALLOCATABLE :: w_3d |
---|
| 495 | INTEGER (KIND=il), DIMENSION (:,:,:), ALLOCATABLE :: k_3d |
---|
| 496 | !! |
---|
| 497 | REAL (kind=rl), DIMENSION (:,:), ALLOCATABLE :: w_mct |
---|
| 498 | INTEGER (kind=il), DIMENSION (:) , ALLOCATABLE :: k_src, k_dst |
---|
| 499 | ! |
---|
| 500 | l_fd = .TRUE. |
---|
| 501 | IF (PRESENT (l_fulldiag)) THEN |
---|
| 502 | l_fd = l_fulldiag |
---|
| 503 | ELSE |
---|
| 504 | !! Estimation de la taille des variables, limitation si > 2GB |
---|
| 505 | i_var = jpoi * jpoj * jmo2a |
---|
| 506 | IF ( i_var >= 2E9_il ) l_fd = .TRUE. |
---|
| 507 | END IF |
---|
| 508 | |
---|
| 509 | IF ( PRESENT (lo_src_grid_frac) ) THEN |
---|
| 510 | l_src_grid_frac = lo_src_grid_frac |
---|
| 511 | ELSE |
---|
| 512 | l_src_grid_frac = .TRUE. |
---|
| 513 | END IF |
---|
| 514 | WRITE (nout,*) 'wri_wei_a2o : l_src_grid_frac : ', l_src_grid_frac |
---|
| 515 | |
---|
| 516 | IF ( PRESENT (lo_dst_grid_frac) ) THEN |
---|
| 517 | l_dst_grid_frac = lo_dst_grid_frac |
---|
| 518 | ELSE |
---|
| 519 | l_dst_grid_frac = .TRUE. |
---|
| 520 | END IF |
---|
| 521 | WRITE (nout,*) 'wri_wei_a2o : l_dst_grid_frac : ', l_dst_grid_frac |
---|
| 522 | |
---|
| 523 | IF ( PRESENT (co_omsk) ) THEN |
---|
| 524 | c_omsk = TRIM(co_omsk) |
---|
| 525 | ELSE |
---|
| 526 | c_omsk = 'perio' |
---|
| 527 | END IF |
---|
| 528 | WRITE (nout,*) 'wri_wei_a2o : c_omsk : ', TRIM ( c_omsk) |
---|
| 529 | |
---|
| 530 | IF ( PRESENT (co_amsk) ) THEN |
---|
| 531 | c_amsk = TRIM( co_amsk) |
---|
| 532 | ELSE |
---|
| 533 | c_amsk = 'int' |
---|
| 534 | END IF |
---|
| 535 | WRITE (nout,*) 'wri_wei_a2o : c_amsk : ', TRIM(c_amsk) |
---|
| 536 | |
---|
| 537 | !IF ( LEN_TRIM(c_suffix) /= 0) c_suffix = '_' // TRIM(c_suffix) |
---|
| 538 | !! |
---|
| 539 | !! Dataset atmosphere --> ocean |
---|
| 540 | !! |
---|
| 541 | clweight = "WEIGHTS" // clnum ; cladress = "ADRESSE" // clnum |
---|
| 542 | WRITE (UNIT = nout, fmt = *) " atm -> oce ", cladress, " ", clweight, " Number of neighbors : ", jma2o |
---|
| 543 | IF (c_oasis == '2.2' ) THEN |
---|
| 544 | IF (l_wei_i4 .OR. l_wei_i8) WRITE (unit = nout, fmt = *) 'Ecriture a2o, fichiers binaires IEEE' |
---|
| 545 | IF (l_wei_i4) THEN |
---|
| 546 | WRITE (UNIT = nwei4a2o) cladress |
---|
| 547 | WRITE (UNIT = nwei4a2o) ((INT (ka2o (jn, jo) , KIND=i_4), jn = 1_il, jma2o), jo = 1_il, jpon) |
---|
| 548 | WRITE (UNIT = nwei4a2o) clweight |
---|
| 549 | WRITE (UNIT = nwei4a2o) ((REAL (wa2o (jn, jo), KIND=rk_out), jn = 1_il, jma2o), jo = 1_il, jpon) |
---|
| 550 | END IF |
---|
| 551 | IF (l_wei_i8) THEN |
---|
| 552 | WRITE (UNIT = nwei8a2o) cladress |
---|
| 553 | WRITE (UNIT = nwei8a2o) ((INT (ka2o (jn, jo), KIND=i_8), jn = 1_il, jma2o), jo = 1_il, jpon) |
---|
| 554 | WRITE (UNIT = nwei8a2o) clweight |
---|
| 555 | WRITE (UNIT = nwei8a2o) ((REAL (wa2o (jn, jo), KIND=rk_out), jn = 1_il, jma2o), jo = 1_il, jpon) |
---|
| 556 | END IF |
---|
| 557 | ENDIF |
---|
| 558 | |
---|
| 559 | ! CALL ipsldbg (new_status=.TRUE. ) |
---|
| 560 | WRITE (unit = nout, fmt = *) 'Ecriture a2o, diagnostiques ', TRIM(cldiag_a2o) |
---|
| 561 | CALL fliocrfd (TRIM(cldiag_a2o) // TRIM(c_suffix), (/'x ', 'y ', 'n ', 'edge'/), (/jpoi, jpoj, jma2o, jpoe/), & |
---|
| 562 | &nca2o, mode=c_FlioMode) |
---|
| 563 | CALL fliopstc (nca2o, & |
---|
| 564 | & x_axis_2d = RESHAPE (xolont, (/jpoi, jpoj/)), & |
---|
| 565 | & y_axis_2d = RESHAPE (xolatt, (/jpoi, jpoj/))) |
---|
| 566 | CALL flioputa (nca2o, '?', 'Comment', TRIM(c_comment) ) |
---|
| 567 | CALL fliodefv (nca2o, 'Weights_Max'//clnum, (/1_il,2_il/), v_t=flio_r4, standard_name='Oce -> Atm max weights') |
---|
| 568 | CALL flioputa (nca2o, 'Weights_Max'//clnum, 'missing_value', 0.0_rl) |
---|
| 569 | CALL fliodefv (nca2o, 'Neighbors'//clnum , (/1_il,2_il/), v_t=flio_i4, standard_name='Oce -> Atm Neighbors') |
---|
| 570 | CALL flioputa (nca2o, 'Neighbors'//clnum, 'missing_value', 0.0_rl) |
---|
| 571 | CALL fliodefv (nca2o, 'Weights_Sum'//clnum, (/1_il,2_il/), v_t=flio_r4, standard_name='Oce -> Atm sum weights') |
---|
| 572 | CALL flioputa (nca2o, 'Weights_Sum'//clnum, 'missing_value', 0.0_rl) |
---|
| 573 | CALL fliodefv (nca2o, 'Mask', (/1_il,2_il/), v_t=flio_i4, standard_name='Oce -> Atm mask') |
---|
| 574 | CALL flioputa (nca2o, 'Mask', 'missing_value', 0.0_rl) |
---|
| 575 | CALL fliodefv (nca2o, 'AtmMask', (/1_il,2_il/), v_t=flio_r4, standard_name='Oce ->Atm OceMask') |
---|
| 576 | CALL flioputa (nca2o, 'AtmMask', 'missing_value', 0.0_rl) |
---|
| 577 | CALL fliodefv (nca2o, 'LonEdge', (/1_il,2_il,4_il/), v_t=flio_r4) |
---|
| 578 | CALL flioputa (nca2o, 'LonEdge', 'missing_value', 0.0_rl) |
---|
| 579 | CALL fliodefv (nca2o, 'LatEdge', (/1_il,2_il,4_il/), v_t=flio_r4) |
---|
| 580 | CALL flioputa (nca2o, 'LatEdge', 'missing_value', 0.0_rl) |
---|
| 581 | IF (l_fd) THEN |
---|
| 582 | CALL fliodefv (nca2o, 'Weights'//clnum, (/1_il,2_il,3_il/), v_t=flio_r4, standard_name='Oce -> Atm Weights') |
---|
| 583 | CALL flioputa (nca2o, 'Weights'//clnum, 'missing_value', 0.0_rl) |
---|
| 584 | CALL fliodefv (nca2o, 'Adresses'//clnum,(/1_il,2_il,3_il/), v_t=flio_i4, standard_name='Oce -> Atm Adresses') |
---|
| 585 | CALL flioputa (nca2o, 'Adresses'//clnum, 'missing_value', 0.0_rl) |
---|
| 586 | CALL fliodefv (nca2o, 'Index_I'//clnum, (/1_il,2_il,3_il/), v_t=flio_i4) |
---|
| 587 | CALL flioputa (nca2o, 'Index_I'//clnum, 'missing_value', 0.0_rl) |
---|
| 588 | CALL fliodefv (nca2o, 'Index_J'//clnum, (/1_il,2_il,3_il/), v_t=flio_i4) |
---|
| 589 | CALL flioputa (nca2o, 'Index_J'//clnum, 'missing_value', 0.0_rl) |
---|
| 590 | END IF |
---|
| 591 | CALL fliodefv (nca2o, 'MaskPer', (/1_il,2_il/), v_t=flio_i4) |
---|
| 592 | CALL flioputa (nca2o, 'MaskPer', 'missing_value', 0.0_rl) |
---|
| 593 | CALL fliodefv (nca2o, 'Surface', (/1_il,2_il/)) |
---|
| 594 | CALL flioputa (nca2o, 'Surface', 'missing_value', 0.0_rl) |
---|
| 595 | CALL fliodefv (nca2o, 'SurfacePol', (/1_il,2_il/)) |
---|
| 596 | CALL flioputa (nca2o, 'SurfacePol', 'missing_value', 0.0_rl) |
---|
| 597 | |
---|
| 598 | ALLOCATE (w_3d(jpoi, jpoj, 1), STAT=ierr) ; CALL chk_allo (ierr, 'w_3d(jpoi,jpoj,1)') |
---|
| 599 | w_3d (1:jpoi , 1:jpoj, 1) = RESHAPE (MAXVAL (wa2o,DIM=1), (/jpoi, jpoj/)) |
---|
| 600 | CALL flioputv (nca2o, 'Weights_Max'//clnum, w_3d (1:jpoi, 1:jpoj, 1) ) |
---|
| 601 | !CALL flioputv (nca2o, 'Weights_Max'//clnum, RESHAPE(MAXVAL(wa2o,DIM=1),(/jpoi, jpoj/)) ) |
---|
| 602 | CALL flioputv (nca2o, 'Neighbors'//clnum, RESHAPE ( MAX (0_il, nvo) ,(/jpoi, jpoj/)) ) |
---|
| 603 | CALL flioputv (nca2o, 'Weights_Sum'//clnum, RESHAPE ( SUM (wa2o,DIM=1),(/jpoi, jpoj/)) ) |
---|
| 604 | CALL flioputv (nca2o, 'Mask', RESHAPE (1_il-iomskt, (/jpoi, jpoj/)) ) |
---|
| 605 | CALL flioputv (nca2o, 'AtmMask', RESHAPE (a2omask, (/jpoi, jpoj/)) ) |
---|
| 606 | CALL flioputv (nca2o, 'LonEdge', RESHAPE (xo_ed, (/jpoi, jpoj, jpoe/)) ) |
---|
| 607 | CALL flioputv (nca2o, 'LatEdge', RESHAPE (yo_ed, (/jpoi, jpoj, jpoe/)) ) |
---|
| 608 | CALL flioputv (nca2o, 'Surface', RESHAPE (xosrft, (/jpoi,jpoj/))) |
---|
| 609 | CALL flioputv (nca2o, 'SurfacePol', RESHAPE(xosrft_pol, (/jpoi,jpoj/))) |
---|
| 610 | DEALLOCATE (w_3d) |
---|
| 611 | |
---|
| 612 | IF (l_fd) THEN |
---|
| 613 | ALLOCATE (w_3d(jpoi, jpoj, jma2o), STAT=ierr) |
---|
| 614 | CALL chk_allo (ierr, 'w_3d(jpoi,jpoj,jma2o)', lreset=.TRUE., crout='wri_wei_a2o') |
---|
| 615 | ALLOCATE (k_3d(jpoi, jpoj, jma2o), STAT=ierr) |
---|
| 616 | CALL chk_allo (ierr, 'k_3d(jpai,jpaj,jmo2a)') |
---|
| 617 | |
---|
| 618 | IF (ierr /= 0 ) THEN |
---|
| 619 | WRITE(UNIT=nout,fmt=*) 'Erreur allocation k_3d dans wri_wei_a2o : ', ierr |
---|
| 620 | STOP |
---|
| 621 | END IF |
---|
| 622 | DO jn = 1_il, jma2o |
---|
| 623 | DO joj = 1_il, jpoj |
---|
| 624 | DO joi = 1_il, jpoi |
---|
| 625 | w_3d (joi, joj, jn) = wa2o (jn, m1o(joi, joj)) |
---|
| 626 | k_3d (joi, joj, jn) = ka2o (jn, m1o(joi, joj)) |
---|
| 627 | END DO |
---|
| 628 | END DO |
---|
| 629 | END DO |
---|
| 630 | !! |
---|
| 631 | IF (limit_stack) THEN |
---|
| 632 | DO jn = 1_il, jma2o |
---|
| 633 | !WRITE (UNIT=nout,FMT='(1I4)') jn |
---|
| 634 | CALL flioputv (nca2o, 'Weights'//clnum, w_3d(:,:,jn), start=(/1_il, 1_il, jn/) ) |
---|
| 635 | ENDDO |
---|
| 636 | ELSE |
---|
| 637 | CALL flioputv (nca2o, 'Weights'//clnum, w_3d(:,:,:) ) |
---|
| 638 | ENDIF |
---|
| 639 | !! |
---|
| 640 | IF (limit_stack) THEN |
---|
| 641 | DO jn = 1_il, jma2o |
---|
| 642 | !WRITE (UNIT=nout,FMT='(1I4)') jn |
---|
| 643 | CALL flioputv (nca2o, 'Adresses'//clnum, k_3d(:,:,jn), start=(/1_il, 1_il, jn/) ) |
---|
| 644 | ENDDO |
---|
| 645 | ELSE |
---|
| 646 | CALL flioputv (nca2o, 'Adresses'//clnum, k_3d(:,:,1:jma2o)) |
---|
| 647 | ENDIF |
---|
| 648 | !! |
---|
| 649 | CALL flioputv (nca2o, 'MaskPer', & |
---|
| 650 | RESHAPE( (1_il-iomskt)*(1_il-iomskp), (/jpoi, jpoj/) ) ) |
---|
| 651 | !! |
---|
| 652 | DEALLOCATE (w_3d) |
---|
| 653 | !! |
---|
| 654 | k_3d = 0_il |
---|
| 655 | DO jn = 1_il, jma2o |
---|
| 656 | DO joj = 1_il, jpoj |
---|
| 657 | DO joi = 1_il, jpoi |
---|
| 658 | k_3d (joi, joj, jn) = m2ai(ka2o(jn, m1o(joi, joj))) |
---|
| 659 | END DO |
---|
| 660 | END DO |
---|
| 661 | END DO |
---|
| 662 | IF (limit_stack) THEN |
---|
| 663 | DO jn = 1_il, jma2o |
---|
| 664 | !WRITE (UNIT=nout,FMT='(1I4)') jn |
---|
| 665 | CALL flioputv (nca2o, 'Index_I'//clnum, k_3d(:,:,jn), start=(/1_il,1_il,jn/) ) |
---|
| 666 | ENDDO |
---|
| 667 | ELSE |
---|
| 668 | CALL flioputv (nca2o, 'Index_I'//clnum, k_3d(:,:,1:jma2o)) |
---|
| 669 | ENDIF |
---|
| 670 | k_3d = 0_il |
---|
| 671 | DO jn = 1_il, jma2o |
---|
| 672 | DO joj = 1_il, jpoj |
---|
| 673 | DO joi = 1_il, jpoi |
---|
| 674 | k_3d (joi, joj, jn) = m2aj(ka2o (jn, m1o(joi, joj))) |
---|
| 675 | END DO |
---|
| 676 | END DO |
---|
| 677 | END DO |
---|
| 678 | IF (limit_stack) THEN |
---|
| 679 | DO jn = 1_il, jma2o |
---|
| 680 | !WRITE (UNIT=nout,FMT='(1I4)') jn |
---|
| 681 | CALL flioputv (nca2o, 'Index_J'//clnum, k_3d(:,:,jn), start=(/1_il,1_il,jn/) ) |
---|
| 682 | END DO |
---|
| 683 | ELSE |
---|
| 684 | CALL flioputv (nca2o, 'Index_J'//clnum, k_3d(:,:,1:jma2o)) |
---|
| 685 | ENDIF |
---|
| 686 | ! |
---|
| 687 | DEALLOCATE (k_3d) |
---|
| 688 | !! |
---|
| 689 | END IF |
---|
| 690 | !! |
---|
| 691 | WRITE (unit=nout,fmt=*) 'Fin ecriture diagnostiques a2o ' |
---|
| 692 | CALL flioclo (nca2o) |
---|
| 693 | !! |
---|
| 694 | !! |
---|
| 695 | !! Ecriture des poids au format NetCDF de OASIS 3 |
---|
| 696 | IF ( l_wei_oasis_3 ) THEN |
---|
| 697 | WRITE (unit=nout,fmt=*) 'Ecriture poids a2o NetCDF, format OASIS 3' |
---|
| 698 | CALL fliocrfd (TRIM(clw_a2o) // TRIM(c_suffix) // '.nc', (/'jma2o', 'jpon '/), (/jma2o, jpon/), il_ncid, mode=c_FlioMode) |
---|
| 699 | CALL flioputa (il_ncid, '?', 'Comment', TRIM(c_comment) ) |
---|
| 700 | CALL fliodefv (il_ncid, 'WEIGHTS'//clnum, (/1,2/), v_t=flio_r) |
---|
| 701 | CALL fliodefv (il_ncid, 'ADRESSE'//clnum, (/1,2/), v_t=flio_i) |
---|
| 702 | ! Write WEIGHTS |
---|
| 703 | IF (limit_stack) THEN |
---|
| 704 | j1 = 1 ; j2 = MIN (slice_size, jma2o) |
---|
| 705 | DO WHILE (j1 < jma2o) |
---|
| 706 | WRITE (UNIT=nout,FMT='("Ecriture wa2o, jn : ", 2I6, 5I8)') j1, j2, SIZE (wa2o(j1:j2,:)) |
---|
| 707 | CALL flioputv (il_ncid, 'WEIGHTS'//clnum, wa2o(j1:j2,:), start=(/j1,1_il/), count=(/j2-j1+1,jpon/) ) |
---|
| 708 | j1 = j1 + slice_size ; j2 = MIN (j1+slice_size-1, jma2o) |
---|
| 709 | END DO |
---|
| 710 | ELSE |
---|
| 711 | WRITE (UNIT=nout,FMT='(5I10)') SIZE (wa2o(1:jma2o,:)), SIZE(wa2o(1:jma2o,:),DIM=1), SIZE(wa2o(1:jma2o,:),DIM=2) |
---|
| 712 | CALL flioputv (il_ncid, 'WEIGHTS'//clnum, wa2o(1:jma2o,:) ) |
---|
| 713 | ENDIF |
---|
| 714 | ! Write ADRESSE |
---|
| 715 | IF (limit_stack) THEN |
---|
| 716 | j1 = 1 ; j2 = MIN (slice_size, jma2o) |
---|
| 717 | DO WHILE ( j1 < jma2o) |
---|
| 718 | WRITE (UNIT=nout,FMT='("Ecriture ka2o, jn : ", 2I6, 5I8)') j1, j2, SIZE (ka2o(j1:j2,:)) |
---|
| 719 | CALL flioputv (il_ncid, 'ADRESSE'//clnum, ka2o(j1:j2,:), start=(/j1,1_il/), count=(/j2-j1+1,jpon/) ) |
---|
| 720 | j1 = j1 + slice_size ; j2 = MIN (j1+slice_size-1, jma2o) |
---|
| 721 | END DO |
---|
| 722 | ELSE |
---|
| 723 | WRITE (UNIT=nout,FMT='(5I10)') SIZE (ka2o(1:jma2o,:)), SIZE (ka2o(1:jma2o,:),DIM=1), SIZE (ka2o(1:jma2o,:),DIM=2) |
---|
| 724 | CALL flioputv (il_ncid, 'ADRESSE'//clnum, ka2o(1:jma2o,:) ) |
---|
| 725 | ENDIF |
---|
| 726 | !! |
---|
| 727 | WRITE (unit=nout, fmt=*) 'Fin ecriture adresses a2o NetCDF, format OASIS 3' |
---|
| 728 | CALL flioclo (il_ncid) |
---|
| 729 | !! |
---|
| 730 | WRITE (unit=nout,fmt=*) 'Ecriture poids a2o NetCDF, format OASIS MCT' |
---|
| 731 | num_links = jpon * jma2o |
---|
| 732 | num_wgts = 1 |
---|
| 733 | ALLOCATE (w_mct(num_wgts,num_links), STAT=ierr) |
---|
| 734 | CALL chk_allo (ierr, 'w_mct(num_wgts,num_links)', lreset=.TRUE., crout='wri_wei_a2o') |
---|
| 735 | ALLOCATE (k_src(num_links), STAT=ierr) |
---|
| 736 | CALL chk_allo (ierr, 'k_src(num_links)', lreset=.TRUE., crout='wri_wei_a2o') |
---|
| 737 | ALLOCATE (k_dst(num_links), STAT=ierr) |
---|
| 738 | CALL chk_allo (ierr, 'k_dst(num_links)', lreset=.TRUE., crout='wri_wei_a2o') |
---|
| 739 | ! |
---|
| 740 | j_link = 0 |
---|
| 741 | DO jo = 1, jpon |
---|
| 742 | DO jn = 1, jma2o |
---|
| 743 | IF ( ka2o (jn, jo) /= 0 ) THEN |
---|
| 744 | j_link = j_link + 1 |
---|
| 745 | k_dst (j_link) = jo |
---|
| 746 | k_src (j_link) = ka2o (jn, jo) |
---|
| 747 | w_mct (1,j_link) = wa2o (jn, jo) |
---|
| 748 | END IF |
---|
| 749 | END DO |
---|
| 750 | END DO |
---|
| 751 | num_links = j_link |
---|
| 752 | ! |
---|
| 753 | END IF |
---|
| 754 | ! |
---|
| 755 | !! Ecriture des poids au format NetCDF de OASIS MCT |
---|
| 756 | IF ( l_wei_oasis_mct ) THEN |
---|
| 757 | CALL fliocrfd (TRIM(clw_a2o_mct) // TRIM(c_suffix), & |
---|
| 758 | & (/'src_grid_size ', 'dst_grid_size ', 'src_grid_corners', 'dst_grid_corners', & |
---|
| 759 | & 'src_grid_rank ', 'dst_grid_rank ', 'num_links ', 'num_wgts '/), & |
---|
| 760 | & (/ jpan , jpon , 4 , 4 , & |
---|
| 761 | & 2 , 2 , num_links , num_wgts /), & |
---|
| 762 | & il_ncid, mode=c_FlioMode) |
---|
| 763 | CALL flioputa (il_ncid, "?", "title" , TRIM(clw_a2o_mct) ) |
---|
| 764 | CALL flioputa (il_ncid, '?', 'Comment', TRIM(c_comment) ) |
---|
| 765 | CALL flioputa (il_ncid, "?", "normalization" , "none" ) |
---|
| 766 | CALL flioputa (il_ncid, "?", "map_method" , "Conservative Remapping" ) |
---|
| 767 | CALL DATE_AND_TIME (c_date, c_time, c_zone ) |
---|
| 768 | CALL flioputa (il_ncid, "?", "history" , "Created: "//c_date(1:4)//"-"//c_date(5:6)//"-"// & |
---|
| 769 | & c_date(7:8)//" "//c_time(1:2)//"h"//c_time(3:4)//" GMT"//TRIM(c_zone) ) |
---|
| 770 | CALL flioputa (il_ncid, "?", "conventions" , "SCRIP" ) |
---|
| 771 | CALL flioputa (il_ncid, "?", "method" , "MOSAIC" ) |
---|
| 772 | CALL flioputa (il_ncid, "?", "source_grid" , "curvilinear" ) |
---|
| 773 | CALL flioputa (il_ncid, "?", "dest_grid" , "curvilinear" ) |
---|
| 774 | CALL flioputa (il_ncid, "?", "Institution" , "IPSL" ) |
---|
| 775 | CALL flioputa (il_ncid, "?", "Model" , "IPSL CM6" ) |
---|
| 776 | CALL flioputa (il_ncid, "?", "Max_nei_num" , jma2o ) |
---|
| 777 | CALL flioputa (il_ncid, "?", "c_amsk" , TRIM(c_amsk)) |
---|
| 778 | CALL flioputa (il_ncid, "?", "c_omsk" , TRIM(c_omsk)) |
---|
| 779 | CALL GET_ENVIRONMENT_VARIABLE ( NAME="HOSTNAME", VALUE=c_tmp, TRIM_NAME=.TRUE., STATUS=i_stat) |
---|
| 780 | IF ( i_stat == 0 ) THEN |
---|
| 781 | CALL flioputa (il_ncid, "?", "HOSTNAME" , TRIM(c_tmp) ) |
---|
| 782 | ELSE |
---|
| 783 | WRITE (nout,*) 'Environment variable not found : $HOSTNAME' |
---|
| 784 | END IF |
---|
| 785 | CALL GET_ENVIRONMENT_VARIABLE ( NAME="LOGNAME" , VALUE=c_tmp, TRIM_NAME=.TRUE., STATUS=i_stat) |
---|
| 786 | IF ( i_stat == 0 ) THEN |
---|
| 787 | CALL flioputa (il_ncid, "?", "LOGNAME" , TRIM(c_tmp) ) |
---|
| 788 | ELSE |
---|
| 789 | WRITE (nout,*) 'Environment variable not found : $LOGNAME' |
---|
| 790 | END IF |
---|
| 791 | ! |
---|
| 792 | CALL fliodefv (il_ncid, 'src_grid_dims' , (/5/) , v_t=flio_i ) |
---|
| 793 | CALL fliodefv (il_ncid, 'dst_grid_dims' , (/6/) , v_t=flio_i ) |
---|
| 794 | CALL fliodefv (il_ncid, 'src_grid_center_lat', (/1/) , v_t=flio_r , units = "degrees_north" ) |
---|
| 795 | CALL fliodefv (il_ncid, 'src_grid_center_lon', (/1/) , v_t=flio_r , units = "degrees_east" ) |
---|
| 796 | CALL fliodefv (il_ncid, 'dst_grid_center_lat', (/2/) , v_t=flio_r , units = "degrees_north" ) |
---|
| 797 | CALL fliodefv (il_ncid, 'dst_grid_center_lon', (/2/) , v_t=flio_r , units = "degrees_east" ) |
---|
| 798 | CALL fliodefv (il_ncid, 'src_grid_corner_lat', (/3,1/), v_t=flio_r , units = "degrees_north" ) |
---|
| 799 | CALL fliodefv (il_ncid, 'src_grid_corner_lon', (/3,1/), v_t=flio_r , units = "degrees_east" ) |
---|
| 800 | CALL fliodefv (il_ncid, 'dst_grid_corner_lat', (/4,2/), v_t=flio_r , units = "degrees_north" ) |
---|
| 801 | CALL fliodefv (il_ncid, 'dst_grid_corner_lon', (/4,2/), v_t=flio_r , units = "degrees_east" ) |
---|
| 802 | CALL fliodefv (il_ncid, 'src_grid_imask' , (/1/) , v_t=flio_i , units = "unitless" ) |
---|
| 803 | CALL fliodefv (il_ncid, 'dst_grid_imask' , (/2/) , v_t=flio_i , units = "unitless" ) |
---|
| 804 | CALL fliodefv (il_ncid, 'src_grid_area' , (/1/) , v_t=flio_r , units = "m^2" ) |
---|
| 805 | CALL fliodefv (il_ncid, 'dst_grid_area' , (/2/) , v_t=flio_r , units = "m^2" ) |
---|
| 806 | CALL fliodefv (il_ncid, 'src_grid_frac' , (/1/) , v_t=flio_r , units = "unitless" ) |
---|
| 807 | CALL fliodefv (il_ncid, 'dst_grid_frac' , (/2/) , v_t=flio_r , units = "unitless" ) |
---|
| 808 | CALL fliodefv (il_ncid, 'dst_address' , (/7/) , v_t=flio_i ) |
---|
| 809 | CALL fliodefv (il_ncid, 'src_address' , (/7/) , v_t=flio_i ) |
---|
| 810 | CALL fliodefv (il_ncid, 'remap_matrix' , (/8,7/), v_t=flio_r ) |
---|
| 811 | ! |
---|
| 812 | CALL flioputa (il_ncid, 'src_grid_imask', 'land_value', 0) |
---|
| 813 | CALL flioputa (il_ncid, 'src_grid_imask', 'sea_value' , 1) |
---|
| 814 | CALL flioputa (il_ncid, 'dst_grid_imask', 'land_value', 0) |
---|
| 815 | CALL flioputa (il_ncid, 'dst_grid_imask', 'sea_value' , 1) |
---|
| 816 | ! |
---|
| 817 | CALL flioputv (il_ncid, 'src_grid_dims' , (/ jpai, jpaj /) ) |
---|
| 818 | CALL flioputv (il_ncid, 'dst_grid_dims' , (/ jpoi, jpoj /) ) |
---|
| 819 | CALL flioputv (il_ncid, 'src_grid_center_lat', xalatt ) |
---|
| 820 | CALL flioputv (il_ncid, 'src_grid_center_lon', lon_180(xalont)) |
---|
| 821 | CALL flioputv (il_ncid, 'dst_grid_center_lat', xolatt ) |
---|
| 822 | CALL flioputv (il_ncid, 'dst_grid_center_lon', lon_180(xolont)) |
---|
| 823 | |
---|
| 824 | CALL flioputv (il_ncid, 'src_grid_corner_lat', ya_ed (:,1) , start=(/1,1/), count=(/1,jpan/) ) |
---|
| 825 | CALL flioputv (il_ncid, 'src_grid_corner_lat', ya_ed (:,3) , start=(/2,1/), count=(/1,jpan/) ) |
---|
| 826 | CALL flioputv (il_ncid, 'src_grid_corner_lat', ya_ed (:,5) , start=(/3,1/), count=(/1,jpan/) ) |
---|
| 827 | CALL flioputv (il_ncid, 'src_grid_corner_lat', ya_ed (:,8) , start=(/4,1/), count=(/1,jpan/) ) |
---|
| 828 | CALL flioputv (il_ncid, 'src_grid_corner_lon', lon_180(xa_ed (:,1)), start=(/1,1/), count=(/1,jpan/) ) |
---|
| 829 | CALL flioputv (il_ncid, 'src_grid_corner_lon', lon_180(xa_ed (:,3)), start=(/2,1/), count=(/1,jpan/) ) |
---|
| 830 | CALL flioputv (il_ncid, 'src_grid_corner_lon', lon_180(xa_ed (:,5)), start=(/3,1/), count=(/1,jpan/) ) |
---|
| 831 | CALL flioputv (il_ncid, 'src_grid_corner_lon', lon_180(xa_ed (:,8)), start=(/4,1/), count=(/1,jpan/) ) |
---|
| 832 | |
---|
| 833 | CALL flioputv (il_ncid, 'dst_grid_corner_lat', yo_ed (:,1) , start=(/1,1/), count=(/1,jpon/) ) |
---|
| 834 | CALL flioputv (il_ncid, 'dst_grid_corner_lat', yo_ed (:,3) , start=(/2,1/), count=(/1,jpon/) ) |
---|
| 835 | CALL flioputv (il_ncid, 'dst_grid_corner_lat', yo_ed (:,5) , start=(/3,1/), count=(/1,jpon/) ) |
---|
| 836 | CALL flioputv (il_ncid, 'dst_grid_corner_lat', yo_ed (:,8) , start=(/4,1/), count=(/1,jpon/) ) |
---|
| 837 | CALL flioputv (il_ncid, 'dst_grid_corner_lon', lon_180(xo_ed (:,1)), start=(/1,1/), count=(/1,jpon/) ) |
---|
| 838 | CALL flioputv (il_ncid, 'dst_grid_corner_lon', lon_180(xo_ed (:,3)), start=(/2,1/), count=(/1,jpon/) ) |
---|
| 839 | CALL flioputv (il_ncid, 'dst_grid_corner_lon', lon_180(xo_ed (:,5)), start=(/3,1/), count=(/1,jpon/) ) |
---|
| 840 | CALL flioputv (il_ncid, 'dst_grid_corner_lon', lon_180(xo_ed (:,8)), start=(/4,1/), count=(/1,jpon/) ) |
---|
| 841 | |
---|
| 842 | SELECT CASE ( TRIM(c_amsk) ) |
---|
| 843 | CASE ( 'ext' ) |
---|
| 844 | CALL flioputv (il_ncid, 'src_grid_imask' , 1-o2amask_i_ext ) |
---|
| 845 | CASE ( 'int' ) |
---|
| 846 | CALL flioputv (il_ncid, 'src_grid_imask' , 1-o2amask_i_int ) |
---|
| 847 | CASE ( 'full') |
---|
| 848 | CALL flioputv (il_ncid, 'src_grid_imask' , 0*(1-o2amask_i_int) ) |
---|
| 849 | END SELECT |
---|
| 850 | |
---|
| 851 | SELECT CASE ( TRIM (c_omsk) ) |
---|
| 852 | CASE ( 'noperio' ) |
---|
| 853 | CALL flioputv (il_ncid, 'dst_grid_imask' , (1-iomskt)*(1-iomskp) ) |
---|
| 854 | CASE ( 'perio' ) |
---|
| 855 | CALL flioputv (il_ncid, 'dst_grid_imask' , (1-iomskt) ) |
---|
| 856 | END SELECT |
---|
| 857 | |
---|
| 858 | CALL flioputv (il_ncid, 'src_grid_area' , xasrft ) |
---|
| 859 | CALL flioputv (il_ncid, 'dst_grid_area' , xosrft ) |
---|
| 860 | IF (l_src_grid_frac) THEN |
---|
| 861 | CALL flioputv (il_ncid, 'src_grid_frac' , o2amask ) |
---|
| 862 | ELSE |
---|
| 863 | CALL flioputv (il_ncid, 'src_grid_frac' , o2amask*0.0_rl+1.0_rl ) |
---|
| 864 | ENDIF |
---|
| 865 | IF (l_dst_grid_frac) THEN |
---|
| 866 | SELECT CASE ( TRIM(c_omsk)) |
---|
| 867 | CASE ('noperio' ) |
---|
| 868 | CALL flioputv (il_ncid, 'dst_grid_frac' , REAL ((1-iomskt)*(1-iomskp),KIND=rl) ) |
---|
| 869 | CASE ( 'perio' ) |
---|
| 870 | CALL flioputv (il_ncid, 'dst_grid_frac' , REAL ((1-iomskt) ,KIND=rl) ) |
---|
| 871 | END SELECT |
---|
| 872 | ELSE |
---|
| 873 | SELECT CASE ( TRIM(c_omsk)) |
---|
| 874 | CASE ('noperio' ) |
---|
| 875 | CALL flioputv (il_ncid, 'dst_grid_frac' , REAL ( (1-0*iomskt)*(1-0*iomskp) ,KIND=rl) ) |
---|
| 876 | CASE ( 'perio' ) |
---|
| 877 | CALL flioputv (il_ncid, 'dst_grid_frac' , REAL ( (1-0*iomskt) ,KIND=rl) ) |
---|
| 878 | END SELECT |
---|
| 879 | END IF |
---|
| 880 | |
---|
| 881 | CALL flioputv (il_ncid, 'dst_address' , k_dst (1:num_links) ) |
---|
| 882 | CALL flioputv (il_ncid, 'src_address' , k_src (1:num_links) ) |
---|
| 883 | CALL flioputv (il_ncid, 'remap_matrix ' , w_mct (1:num_wgts,1:num_links) ) |
---|
| 884 | |
---|
| 885 | !! |
---|
| 886 | CALL flioclo (il_ncid) |
---|
| 887 | END IF |
---|
| 888 | !! |
---|
| 889 | !! |
---|
| 890 | RETURN |
---|
| 891 | END SUBROUTINE wri_weights_a2o |
---|
| 892 | END MODULE mod_wri_wei |
---|