[4] | 1 | !> \file massb-GrIce2sea_RCM.f90 |
---|
| 2 | !! Calcule le mass balance d'apres un fichier de snapshots |
---|
| 3 | !! avec la temperature parametree |
---|
| 4 | !< |
---|
| 5 | |
---|
| 6 | !> SUBROUTINE: massb_Ice2sea_RCM |
---|
| 7 | !! \author Cat |
---|
| 8 | !! \date 1 er juillet 2012 |
---|
| 9 | !! @note Routine qui utilise un fichier de snapshots |
---|
| 10 | !! et la temperature en surface avec un lapse rate |
---|
| 11 | !! version groenland voir plus tard si convient Antarctique |
---|
| 12 | !! |
---|
| 13 | !! @note Used modules: |
---|
| 14 | !! @note - use module3D_phy |
---|
| 15 | !! @note - use climat_Grice2sea_mod |
---|
| 16 | !< |
---|
| 17 | |
---|
| 18 | |
---|
| 19 | |
---|
| 20 | subroutine massb_Ice2sea_RCM ! calcule le mass balance |
---|
| 21 | |
---|
| 22 | use module3D_phy |
---|
| 23 | use climat_Grice2sea_years_mod |
---|
| 24 | |
---|
| 25 | implicit none |
---|
| 26 | integer :: k_snap ! pour calculer les indices de temps |
---|
| 27 | real :: time_bis ! pour repliquer les dernieres annees |
---|
| 28 | ! surface temperature et accumulation |
---|
| 29 | |
---|
| 30 | Tann (:,:) = Ta0 (:,:) + T_lapse_rate * (S(:,:)-S0(:,:)) |
---|
| 31 | Ts(:,:) = Tann(:,:) |
---|
| 32 | |
---|
| 33 | |
---|
| 34 | |
---|
| 35 | ! calcule bm_time par interpolation entre deux snapshots |
---|
| 36 | ! avant prend la valeur de reference |
---|
| 37 | ! apres prend la derniere valeur |
---|
| 38 | |
---|
| 39 | ! en general les snapshots vont de 2000 a 2200 |
---|
| 40 | |
---|
| 41 | |
---|
| 42 | if(time.lt.time_snap(1)) then ! time avant le forcage |
---|
| 43 | bm_time(:,:) = bm_0(:,:) |
---|
| 44 | k_snap = 1 |
---|
| 45 | S_ref(:,:) = S(:,:) ! du coup sera la surface de reference avant le forcage |
---|
| 46 | icum = 0 |
---|
| 47 | i_moy = 0 |
---|
| 48 | bm_ref_t(:,:)= bm_0(:,:) ! bilan de masse de reference |
---|
| 49 | time_prec = time |
---|
| 50 | |
---|
| 51 | |
---|
| 52 | else if (time.ge.time_snap(nb_snap)) then ! time apres le forcage |
---|
| 53 | k_snap = nb_snap |
---|
| 54 | bm_time(:,:) = smb_snap (:,:,k_snap) |
---|
| 55 | |
---|
| 56 | if (abs(time-time_prec-1.).lt.dt) then ! |
---|
| 57 | time_prec = time_prec + 1 |
---|
| 58 | icum = 1 |
---|
| 59 | else |
---|
| 60 | icum = 0 |
---|
| 61 | endif |
---|
| 62 | |
---|
| 63 | |
---|
| 64 | else ! cas general |
---|
| 65 | |
---|
| 66 | do k = 1 , nb_snap-1 |
---|
| 67 | |
---|
| 68 | if((time.ge.time_snap(k)).and.(time.lt.time_snap(k+1))) then ! entre k et k+1 |
---|
| 69 | bm_time(:,:) = smb_snap(:,:,k)+(smb_snap(:,:,k+1)-smb_snap(:,:,k)) * & |
---|
| 70 | (time-time_snap(k))/(time_snap(k+1)-time_snap(k)) |
---|
| 71 | |
---|
| 72 | |
---|
| 73 | ! exactement sur le snapshot et avec un ecart 1 an par rapport au precedent stockage |
---|
| 74 | ! write(6,*) 'time,tests',k,time,time-time_snap(k),time-time_prec-1. |
---|
| 75 | if ((abs(time-time_snap(k)).le.dt).and.(abs(time-time_prec-1.).lt.dt)) then |
---|
| 76 | k_snap = k |
---|
| 77 | icum = 1 |
---|
| 78 | time_prec = time_snap(k) ! time_prec est le temps du precedent |
---|
| 79 | ! snapshot garde |
---|
| 80 | else |
---|
| 81 | icum = 0 |
---|
| 82 | endif |
---|
| 83 | |
---|
| 84 | exit |
---|
| 85 | endif |
---|
| 86 | |
---|
| 87 | end do |
---|
| 88 | |
---|
| 89 | endif |
---|
| 90 | |
---|
| 91 | |
---|
| 92 | call grad_smb !-----------------------------> A faire |
---|
| 93 | |
---|
| 94 | ! ajuste bm en fonction du temps et du gradient |
---|
| 95 | |
---|
| 96 | bm(:,:) = bm_time(:,:) + grad_bm(:,:) *(S(:,:) - S_ref(:,:)) |
---|
| 97 | |
---|
| 98 | write(6,897) time, time_prec, icum, i_moy |
---|
| 99 | 897 format('test temps smb ',2(f0.3,1x),2(i0,1x)) |
---|
| 100 | |
---|
| 101 | ! garde les 10 dernieres annees et calcule la moyenne |
---|
| 102 | |
---|
| 103 | if (icum.eq.1) then ! stockage dans le tableau bm_ref_10 |
---|
| 104 | do k = 9,1,-1 |
---|
| 105 | bm_ref_10(:,:,k+1) = bm_ref_10(:,:,k) ! on decale tous les elements |
---|
| 106 | end do |
---|
| 107 | bm_ref_10(:,:,k+1) = bm(:,:) ! le plus recent est en position 1 |
---|
| 108 | i_moy = i_moy +1 ! compte combien il y en a pour la moyenne |
---|
| 109 | i_moy = min(i_moy,10) |
---|
| 110 | |
---|
| 111 | bm_ref_t(:,:) = 0. |
---|
| 112 | do k = 1,i_moy |
---|
| 113 | bm_ref_t(:,:) = bm_ref_t(:,:) + bm_ref_10(:,:,k) |
---|
| 114 | end do |
---|
| 115 | bm_ref_t(:,:) = bm_ref_t(:,:)/i_moy |
---|
| 116 | |
---|
| 117 | write(6,898) time, time_prec, icum, i_moy |
---|
| 118 | 898 format('cumul pour gradient ',2(f0.3,1x),2(i0,1x)) |
---|
| 119 | end if |
---|
| 120 | |
---|
| 121 | |
---|
| 122 | ! ablation (fonction de T et acc) est maintenant appelee dans le main |
---|
| 123 | ! et dans steps_time_loop. |
---|
| 124 | ! On fait donc une routine fake ici |
---|
| 125 | |
---|
| 126 | ! massb_Ice2sea_fixe est appeles par forclim du module climat_Grice2sea_mod |
---|
| 127 | |
---|
| 128 | |
---|
| 129 | debug_3D(:,:,29) = Tann(:,:)-Ta0(:,:) |
---|
| 130 | debug_3D(:,:,30) = Acc(:,:)-precip(:,:) |
---|
| 131 | debug_3D(:,:,97) = bm_ref_t(:,:) |
---|
| 132 | debug_3D(:,:,98) = grad_bm(:,:) |
---|
| 133 | debug_3D(:,:,99) = bm_time(:,:) |
---|
| 134 | return |
---|
| 135 | end subroutine massb_Ice2sea_RCM |
---|
| 136 | !------------------------------------------------------------------------------ |
---|
| 137 | !> initialise le calcul du gradient vertical de smb |
---|
| 138 | subroutine init_grad_smb |
---|
| 139 | |
---|
| 140 | |
---|
| 141 | use module3D_phy |
---|
| 142 | use climat_Grice2sea_years_mod |
---|
| 143 | implicit none |
---|
| 144 | |
---|
| 145 | character(len=120) :: file_grad_smb ! nom du fichier gradients de Tamsin |
---|
| 146 | character(len=40) :: fin_ligne ! fin de la ligne |
---|
| 147 | real :: grad |
---|
| 148 | |
---|
| 149 | namelist/grad_smb/file_grad_smb |
---|
| 150 | |
---|
| 151 | ! Dans lequel sont : |
---|
| 152 | ! grad_N_smb_pos,grad_N_smb_neg,grad_S_smb_pos,grad_S_smb_neg,lim_lat |
---|
| 153 | |
---|
| 154 | rewind(num_param) ! pour revenir au debut du fichier param_list.dat |
---|
| 155 | read(num_param,grad_smb) |
---|
| 156 | |
---|
| 157 | |
---|
| 158 | ! formats pour les ecritures dans 42 |
---|
| 159 | 428 format(A) |
---|
| 160 | |
---|
| 161 | rewind(num_param) ! pour revenir au debut du fichier param_list.dat |
---|
| 162 | read(num_param,grad_smb) |
---|
| 163 | |
---|
| 164 | write(num_rep_42,428)'!___________________________________________________________' |
---|
| 165 | write(num_rep_42,428)'! gradient smb GrIce2sea gradients_18_07_2012 ' |
---|
| 166 | write(num_rep_42,grad_smb) |
---|
| 167 | write(num_rep_42,428)'!___________________________________________________________' |
---|
| 168 | |
---|
| 169 | |
---|
| 170 | file_grad_smb=trim(dirnameinp)//'SMB-H-Feedback/gradients_18_07_2012/'//trim(file_grad_smb) |
---|
| 171 | open(622,file=file_grad_smb) |
---|
| 172 | do i=1,4 |
---|
| 173 | read(622,'(f9.4,A)') grad,fin_ligne |
---|
| 174 | write(6,*) grad,fin_ligne |
---|
| 175 | |
---|
| 176 | if (index(fin_ligne, "North").ne.0) then ! North est dans la ligne |
---|
| 177 | if (index(fin_ligne, "<").ne.0) then ! smb negatif |
---|
| 178 | grad_N_smb_neg = grad |
---|
| 179 | else if (index(fin_ligne, ">=").ne.0) then ! smb positif |
---|
| 180 | grad_N_smb_pos = grad |
---|
| 181 | else |
---|
| 182 | write(6,*) 'probleme lecture North fichier smb', file_grad_smb |
---|
| 183 | STOP |
---|
| 184 | end if |
---|
| 185 | |
---|
| 186 | else if (index(fin_ligne, "South").ne.0) then !South est dans la ligne |
---|
| 187 | if (index(fin_ligne, "<").ne.0) then ! smb negatif |
---|
| 188 | grad_S_smb_neg = grad |
---|
| 189 | else if (index(fin_ligne, ">=").ne.0) then ! smb positif |
---|
| 190 | grad_S_smb_pos = grad |
---|
| 191 | else |
---|
| 192 | write(6,*) 'probleme lecture South fichier smb ', file_grad_smb |
---|
| 193 | STOP |
---|
| 194 | end if |
---|
| 195 | |
---|
| 196 | else |
---|
| 197 | write(6,*) 'probleme lecture ni North ni South fichier smb ', file_grad_smb |
---|
| 198 | write(6,*) 'fin_ligne',fin_ligne,' index North', index(fin_ligne, "North"),' index South', index(fin_ligne, "South") |
---|
| 199 | STOP |
---|
| 200 | end if |
---|
| 201 | end do |
---|
| 202 | |
---|
| 203 | write(6,*) 'coefficients lus ' |
---|
| 204 | write(6,*) 'grad_N_smb_pos', grad_N_smb_pos |
---|
| 205 | write(6,*) 'grad_N_smb_neg', grad_N_smb_neg |
---|
| 206 | write(6,*) 'grad_S_smb_pos', grad_S_smb_pos |
---|
| 207 | write(6,*) 'grad_S_smb_neg', grad_S_smb_neg |
---|
| 208 | |
---|
| 209 | grad_N_smb_pos = coef_smb_unit * grad_N_smb_pos |
---|
| 210 | grad_N_smb_neg = coef_smb_unit * grad_N_smb_neg |
---|
| 211 | grad_S_smb_pos = coef_smb_unit * grad_S_smb_pos |
---|
| 212 | grad_S_smb_neg = coef_smb_unit * grad_S_smb_neg |
---|
| 213 | |
---|
| 214 | write(6,*) 'coefficients *coef_smb_unit ' |
---|
| 215 | write(6,*) 'grad_N_smb_pos', grad_N_smb_pos |
---|
| 216 | write(6,*) 'grad_N_smb_neg', grad_N_smb_neg |
---|
| 217 | write(6,*) 'grad_S_smb_pos', grad_S_smb_pos |
---|
| 218 | write(6,*) 'grad_S_smb_neg', grad_S_smb_neg |
---|
| 219 | |
---|
| 220 | |
---|
| 221 | end subroutine init_grad_smb |
---|
| 222 | |
---|
| 223 | |
---|
| 224 | !------------------------------------------------------------------------------ |
---|
| 225 | !> Calcule le gradient vertical de smb |
---|
| 226 | |
---|
| 227 | subroutine grad_smb |
---|
| 228 | |
---|
| 229 | use module3D_phy |
---|
| 230 | use climat_Grice2sea_years_mod |
---|
| 231 | implicit none |
---|
| 232 | |
---|
| 233 | do j = 1,ny |
---|
| 234 | do i = 1,nx |
---|
| 235 | if (Ylat(i,j).gt.77.) then ! region nord |
---|
| 236 | if (bm_ref_t(i,j).lt. 0.) then ! smb negatif |
---|
| 237 | grad_bm (i,j) = grad_N_smb_neg |
---|
| 238 | |
---|
| 239 | else if (bm_ref_t(i,j).ge. 0.) then ! smb positif |
---|
| 240 | grad_bm (i,j) = grad_N_smb_pos |
---|
| 241 | |
---|
| 242 | end if |
---|
| 243 | |
---|
| 244 | else if (Ylat(i,j).le.77.) then ! region sud |
---|
| 245 | if (bm_ref_t(i,j).lt. 0.) then ! smb negatif |
---|
| 246 | grad_bm (i,j) = grad_S_smb_neg |
---|
| 247 | |
---|
| 248 | else if (bm_ref_t(i,j).ge. 0.) then ! smb positif |
---|
| 249 | grad_bm (i,j) = grad_S_smb_pos |
---|
| 250 | |
---|
| 251 | end if |
---|
| 252 | end if |
---|
| 253 | end do |
---|
| 254 | end do |
---|
| 255 | |
---|
| 256 | end subroutine grad_smb |
---|
| 257 | !------------------------------------------------------------------------------ |
---|
| 258 | |
---|
| 259 | |
---|