!> \file climat_InitMIP_mod.f90 ! forcage avec BM !! Module ou les variations temporelles des variables climatiques !! sont directement imposees !< !> \namespace climat_InitMIP_mod !! Module ou les variations temporelles des variables climatiques !! sont directement imposees en suivant le protocol initMIP !! \author afq !! \date 10 oct 17 !! @note Used modules: !! @note - use module3D_phy !< module climat_InitMIP_years_perturb_mod use module3d_phy,only: nx,ny,S,S0,H,Bsoc,acc,abl,BM,Tann,Tjuly,Ts,time,dt,num_param,num_rep_42,num_forc,dirforcage,dirnameinp,tafor,time,sealevel,coefbmshelf use netcdf use io_netcdf_grisli implicit none real :: T_lapse_rate !< pour la temperature ! anomalies: smb and bmelt real,dimension(nx,ny) :: smb_anom !> bilan de masse des anomalies indices : nx,ny ! declaration pour le bilan de masse et le bmelt real,dimension(nx,ny) :: bm_0 !> bilan de masse initial real :: coef_smb_unit ! pour corriger l'unite real,dimension(nx,ny) :: TA0 !> Temp annuelle sur S0 ! aurel, pour climat type perturb: integer nft !> nombre de lignes a lire dans le fichier forcage climatique real,dimension(:),allocatable :: tdate !> time for climate forcing real,dimension(:),allocatable :: tpert !> temperature for climate forcing real,dimension(:),allocatable :: spert !> sea surface perturbation real :: coefT !> pour modifier l'amplitude de la perturb. T character(len=120) :: filforc !> nom du fichier forcage integer :: pertsmb !> boolean: do we modify the smb? real :: rapsmb !> if we modify the smb this is the equivalent of rappact ! pour les lectures ncdf real*8, dimension(:,:), pointer :: tab !< tableau 2d real pointer Character(len=10), dimension(3) :: dimtestname !> pour la sortie test netcdf integer :: ncidloc !> pour la sortie test netcdf integer :: status !> pour la sortie test netcdf integer :: massb_time !< pour selectionner le type de calcul de smb ! smb fixe ou en appliquant les anomalies contains !-------------------------------------------------------------------------------- !> SUBROUTINE: input_clim !! Routine qui permet d'initialiser les variations temporelles des variables climatiques !> !-------------------------------------------------------------------------------- subroutine input_clim character(len=100) :: smb_file ! fichier smb character(len=100) :: temp_annual_file ! temperature annuelles character(len=100) :: file_smb_anom !> nom du fichier dans lequel il y a l'anomalie smb integer :: err ! recuperation d'erreur integer :: i !aurel for Tafor: character(len=8) :: control !label to check clim. forc. file (filin) is usable character(len=80):: filin namelist/clim_smb_T_gen/smb_file,coef_smb_unit,temp_annual_file namelist/smb_anom_initMIP/file_smb_anom,massb_time 428 format(A) rewind(num_param) ! pour revenir au debut du fichier param_list.dat read(num_param,clim_smb_T_gen) write(num_rep_42,428)'!________________________________________________________________' write(num_rep_42,428)'! module climat_InitMIP_years_mod lecture climat ref ' write(num_rep_42,clim_smb_T_gen) write(num_rep_42,428)'! smb_file = fichier SMB (kg/m2/an) ' write(num_rep_42,428)'! coef_smb_unit = coef passage m glace/an (1/910 ou 1/918) ' write(num_rep_42,428)'! temp_annual_file = Temp moy annuelle (°C) ' write(num_rep_42,428)'!________________________________________________________________' ! smb : surface mass balance smb_file = trim(dirnameinp)//trim(smb_file) call Read_Ncdf_var('smb',smb_file,tab) bm(:,:) = tab(:,:) * coef_smb_unit acc(:,:) = 0. abl(:,:) = 0. where (bm(:,:).gt.0.) acc(:,:) = bm(:,:) ! accumulation quand positif elsewhere abl(:,:) = - bm(:,:) ! ablation quand negatif end where ! surface temperature Tann temp_annual_file = trim(dirnameinp)//trim(temp_annual_file) call Read_Ncdf_var('Tann',temp_annual_file,tab) Tann(:,:) = tab(:,:) ta0(:,:) = Tann(:,:) Tjuly(:,:) = Tann(:,:) ! ______ Anomalies... rewind(num_param) ! pour revenir au debut du fichier param_list.dat read(num_param,smb_anom_initMIP) write(num_rep_42,428)'!_______________________________________________________________________' write(num_rep_42,428)'! module climat_InitMIP_years_mod ' write(num_rep_42,smb_anom_initMIP) write(num_rep_42,428)'! file_smb_anom = fichier anomalie SMB de GCM ' write(num_rep_42,428)'! massb_time = 0:fixe, 1:anomalies ' write(num_rep_42,428)'!_______________________________________________________________________' file_smb_anom = trim(dirnameinp)//trim(file_smb_anom) call Read_Ncdf_var('asmb',file_smb_anom,tab) smb_anom (:,:) = Tab(:,:) !* coef_smb_unit already in m/yr bm_0(:,:) = bm(:,:) filin=trim(dirforcage)//trim(filforc) open(num_forc,file=filin,status='old') read(num_forc,*) control,nft ! Determination of file size (line nb), allocation of perturbation array if (control.ne.'nb_lines') then write(6,*) filin,'indiquer le nb de ligne en debut de fichier:' write(6,*) 'le nb de lignes et le label de control nb_lines' stop endif ! Dimensionnement des tableaux tdate, .... if (.not.allocated(tdate)) then allocate(tdate(nft),stat=err) if (err/=0) then print *,"erreur a l'allocation du tableau Tdate",err stop 4 end if end if if (.not.allocated(spert)) then allocate(spert(nft),stat=err) if (err/=0) then print *,"erreur a l'allocation du tableau Spert",err stop 4 end if end if if (.not.allocated(tpert)) then allocate(tpert(nft),stat=err) if (err/=0) then print *,"erreur a l'allocation du tableau Tpert",err stop 4 end if end if do i=1,nft read(num_forc,*) tdate(i),spert(i),tpert(i) end do close(num_forc) tpert(:)=tpert(:)*coefT end subroutine input_clim !-------------------------------------------------------------------------------- !> SUBROUTINE: init_forclim !! Routine qui permet d'initialiser les variables climatiques au cours du temps !> subroutine init_forclim implicit none namelist/lapse_rates/T_lapse_rate namelist/clim_pert_massb/coefT,filforc,pertsmb,rapsmb rewind(num_param) ! pour revenir au debut du fichier param_list.dat read(num_param,lapse_rates) ! formats pour les ecritures dans 42 428 format(A) rewind(num_param) ! pour revenir au debut du fichier param_list.dat read(num_param,lapse_rates) write(num_rep_42,428)'!________________________________________________________________' write(num_rep_42,428)'! module climat_InitMIP_years_mod ' write(num_rep_42,lapse_rates) write(num_rep_42,428)'!T_lapse_rate = lapse rate temp annuelle ' write(num_rep_42,428)'!________________________________________________________________' rewind(num_param) read(num_param,clim_pert_massb) write(num_rep_42,428)'!___________________________________________________________' write(num_rep_42,428) '&clim_pert ! module climat_perturb_mod ' write(num_rep_42,*) write(num_rep_42,*) 'coefT = ', coefT write(num_rep_42,'(A,A)') ' filforc = ', filforc write(num_rep_42,*) 'pertsmb = ', pertsmb write(num_rep_42,*) 'rapsmb = ', rapsmb write(num_rep_42,*)'/' write(num_rep_42,*) ! appelle la routine de lecture des smb annuels call input_clim return end subroutine init_forclim !-------------------------------------------------------------------------------- !> SUBROUTINE: forclim !! !! Routine qui permet le calcul climatique au cours du temps !! @note Au temps considere (time) attribue les scalaires !! @note - tafor : forcage en temperature !! @note - sealevel : forcage niveau des mers !! @note - coefbmelt : forcage fusion basale ice shelves !> subroutine forclim ! au temps considere (time) implicit none integer i,ift real :: coefanomtime coefanomtime = min ( real(time/40.) , 1. ) if (massb_time.eq.0) then bm(:,:) = bm_0(:,:) else if (massb_time.eq.1) then bm(:,:) = bm_0(:,:) + coefanomtime * smb_anom(:,:) end if if(time.lt.tdate(1)) then tafor=tpert(1) sealevel=spert(1) ift=1 else if (time.ge.tdate(nft)) then tafor=tpert(nft) sealevel=spert(nft) ift=nft else do i=1,nft-1 if((time.ge.tdate(i)).and.(time.lt.tdate(i+1))) then ! entre i et i+1 : cas general tafor=tpert(i)+(tpert(i+1)-tpert(i))* & (time-tdate(i))/(tdate(i+1)-tdate(i)) sealevel=spert(i)+(spert(i+1)-spert(i))* & (time-tdate(i))/(tdate(i+1)-tdate(i)) ift=i goto 100 endif end do endif 100 continue Tann (:,:) = Ta0 (:,:) + T_lapse_rate * (S(:,:)-S0(:,:)) +Tafor Ts(:,:) = Tann(:,:) ! aurel marion dufresne: we might want to decrease the SMB during glacials..? if (pertsmb.eq.1) then bm(:,:) = bm_0(:,:) * exp( rapsmb *(Tann(:,:)-Ta0(:,:))) if (Tafor.lt.0.) then where(bm(:,:).lt.0.) bm(:,:)=min(bm(:,:)-Tafor*0.05,1.) !10 degrees less give 0.5 meter more ? end if end if ! coefmshelf est un coefficient qui fait varier bmgrz et bmshelf en fonction de tafor coefbmshelf=(1.+tafor/10.) ! coefbmshelf=0 pour tafor=-10deg coefbmshelf=max(coefbmshelf,0.) coefbmshelf=min(coefbmshelf,2.) end subroutine forclim end module climat_InitMIP_years_perturb_mod