├── .DS_Store ├── Data Assimilation Code ├── .DS_Store ├── DA_cycle.f90 ├── DA_time.f90 ├── Makefile ├── data │ └── README.txt ├── ensemble │ └── README.txt ├── input │ └── README.txt ├── mod_analysis.f90 ├── mod_date.f90 ├── mod_matrix_A.f90 ├── mod_matrix_H.f90 ├── mod_matrix_L.f90 ├── mod_matrix_R.f90 ├── mod_matrix_W.f90 ├── mod_matrix_inverse.f90 ├── mod_matrix_read.f90 ├── mod_matrix_write.f90 ├── mod_namelist.f90 ├── mod_obs_sorting.f90 ├── mod_obs_superobing.f90 ├── mod_params.f90 ├── mod_read_coor.f90 ├── mod_read_data.f90 └── output │ └── README.txt ├── Matlab Code for Data Analysis └── read_da_output.m └── Readme.txt /.DS_Store: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ChakoChen/Data-Assimilation-for-Ocean-Current-Forecasts/e4d2738527b430e37af9751cfdd0603d9952b4bb/.DS_Store -------------------------------------------------------------------------------- /Data Assimilation Code/.DS_Store: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ChakoChen/Data-Assimilation-for-Ocean-Current-Forecasts/e4d2738527b430e37af9751cfdd0603d9952b4bb/Data Assimilation Code/.DS_Store -------------------------------------------------------------------------------- /Data Assimilation Code/DA_cycle.f90: -------------------------------------------------------------------------------- 1 | program DA_cycle 2 | use mod_params, only : step 3 | use mod_analysis 4 | use mod_matrix_A 5 | implicit none 6 | integer :: yyyy, mm, dd, hh, ff, ss, time(6) 7 | 8 | if (step) call A_matrix() ! A matrix: run only 1 time before DA cycles 9 | 10 | open(unit=11,file='DA_time.txt') 11 | read (11,*) yyyy, mm, dd, hh, ff, ss 12 | close(11) 13 | 14 | time = (/yyyy,mm,dd,hh,ff,ss/) 15 | 16 | call analysis(time) 17 | 18 | stop 19 | end program DA_cycle 20 | -------------------------------------------------------------------------------- /Data Assimilation Code/DA_time.f90: -------------------------------------------------------------------------------- 1 | ! This stand-alone program writes a time file for DA to start with. The time 2 | ! file is determined from the last snapshot output date from NEMO. This date 3 | ! is the date for a new DA cycle. 4 | program DA_time 5 | implicit none 6 | integer :: name_len, yyyy, mm, dd, hh, ff, ss 7 | character(len=:), allocatable :: fname 8 | 9 | open(11,file='name_length',form='formatted',action='read') 10 | read(11,'(I3)') name_len 11 | close(11) 12 | 13 | allocate(character(len=name_len) :: fname) 14 | open(12,file='name_example',form='formatted',action='read') 15 | read(12,*) fname 16 | close(12) 17 | 18 | ! e.g.: ANHA12-TEST02_1d_20020101_20020102_grid_U_0114.nc 19 | ! e.g.: ANHA4-DASSIM_1d_20140702_20140704_grid_T_0016.nc 20 | read(fname(name_len-22:name_len-19),'(I4)') yyyy 21 | read(fname(name_len-18:name_len-17),'(I2)') mm 22 | read(fname(name_len-16:name_len-15),'(I2)') dd 23 | hh = 12 24 | ff = 0 25 | ss = 0 26 | 27 | open(unit=13,file='DA_time.txt') 28 | write(13,*) yyyy, mm, dd, hh, ff, ss 29 | close(13) 30 | 31 | stop 32 | end program DA_time 33 | -------------------------------------------------------------------------------- /Data Assimilation Code/Makefile: -------------------------------------------------------------------------------- 1 | # Portland Group Compiler 2 | #FC = pgf90 3 | #FFLAGS = -g -C 4 | 5 | # GNU Compiler 6 | #FC = gfortran 7 | #FFLAGS = -g -C -mcmodel=medium -fbackslash -fconvert=big-endian 8 | #FFLAGS = -g -C 9 | 10 | # Intel Compiler 11 | FC = ifort 12 | #FFLAGS = -g -C -shared-intel -convert big_endian -I${NFDIR}/include -L${NFDIR}/lib -lnetcdff 13 | #FFLAGS = -g -C -O3 -mcmodel=medium -convert big_endian -I${NCDF_INC} -L${NCDF_LIB} -lnetcdf -lnetcdff 14 | FFLAGS = -g -C -O3 -xHost -ipo -no-prec-div -mcmodel=medium -convert big_endian -lnetcdf -lnetcdff 15 | #FFLAGS = -g -C 16 | #FFLAGS = -g -C -convert big_endian 17 | #FFLAGS = -g -check bounds -fpe0 -ftrapuv -debug semantic_stepping -debug variable_locations -fpp 18 | #FFLAGS = -O3 -ipo -no-prec-div 19 | 20 | %.o:%.f90 21 | $(FC) -c $(FFLAGS) $< 22 | 23 | SOURCES = mod_params.f90 mod_date.f90 mod_namelist.f90 mod_read_coor.f90 mod_read_data.f90 mod_matrix_read.f90 mod_matrix_write.f90 mod_obs_superobing.f90 mod_obs_sorting.f90 mod_matrix_A.f90 mod_matrix_H.f90 mod_matrix_L.f90 mod_matrix_R.f90 mod_matrix_inverse.f90 mod_matrix_W.f90 mod_analysis.f90 DA_cycle.f90 24 | 25 | runOBJS = mod_params.o mod_date.f90 mod_namelist.o mod_read_coor.o mod_read_data.o mod_matrix_read.o mod_matrix_write.o mod_obs_superobing.o mod_obs_sorting.o mod_matrix_A.o mod_matrix_H.o mod_matrix_L.o mod_matrix_R.o mod_matrix_inverse.o mod_matrix_W.o mod_analysis.o DA_cycle.o 26 | 27 | run:$(runOBJS) 28 | $(FC) $(FFLAGS) $(runOBJS) -o run 29 | 30 | clean: 31 | rm *.mod *.o run /home/chako/Argo/bias_nay/Index* /home/chako/Argo/bias_nay/bin* ensemble/R* ensemble/W* ensemble/H* ensemble/L* ensemble/AH* DA_time.txt input/* 32 | 33 | depend: 34 | sfmakedepend $(SOURCES) 35 | 36 | # DO NOT DELETE THIS LINE - used by make depend 37 | mod_namelist.o: mod_params.o 38 | 39 | mod_read_coor.o: mod_params.o 40 | 41 | mod_read_data.o: mod_params.o 42 | 43 | mod_obs_superobing.o: mod_params.o 44 | 45 | mod_obs_sorting.o: mod_params.o mod_obs_superobing.o 46 | 47 | mod_matrix_A.o: mod_params.o mod_namelist.o mod_read_coor.o mod_read_data.o mod_matrix_read.o mod_matrix_write.o 48 | 49 | mod_matrix_H.o: mod_params.o mod_matrix_read.o mod_matrix_write.o 50 | 51 | mod_matrix_L.o: mod_params.o mod_matrix_write.o mod_matrix_read.o 52 | 53 | mod_matrix_R.o: mod_params.o mod_matrix_write.o 54 | 55 | mod_matrix_W.o: mod_params.o mod_date.o mod_matrix_read.o mod_matrix_write.o mod_matrix_H.o mod_matrix_L.o mod_matrix_R.o mod_matrix_inverse.o 56 | 57 | mod_analysis.o: mod_params.o mod_date.o mod_matrix_A.o mod_read_data.o mod_matrix_read.o mod_obs_sorting.o mod_matrix_W.o 58 | 59 | DA_cycle.o: mod_params.o mod_matrix_A.o mod_analysis.o 60 | -------------------------------------------------------------------------------- /Data Assimilation Code/data/README.txt: -------------------------------------------------------------------------------- 1 | Freerun output saves here for computing the background matrix (i.e. B and A matrices). 2 | -------------------------------------------------------------------------------- /Data Assimilation Code/ensemble/README.txt: -------------------------------------------------------------------------------- 1 | Here is the list under my Argo data assimilation ensemble folder: 2 | 3 | Amatrix.dta : matrix A(nxN), where n = ii*jj*kk*2 (ii,jj,kk are grid point numbers in x,y,z direction, 2 is because of T and S; N is the ensemble member) 4 | ASmatrix.dta : (lower part of A matrix (n/2 * N)) 5 | ATmatrix.dta : (upper part of A matrix (n/2 * N)) 6 | coordinate.dta : (lon and lat for data assimilation domain) 7 | ensemble_mean_sal.dta : (ensemble mean of salinity) 8 | ensemble_mean_tmp.dta : (ensemble mean of temperature) 9 | ensemble_sprd_sal.dta : (ensemble spread/std of salinity) 10 | ensemble_sprd_tmp.dta : (ensemble spread/std of temperature) 11 | model_sprd_sal.dta : same as ensemble spread of salinity 12 | model_sprd_tmp.dta : same as ensemble spread of temperature 13 | -------------------------------------------------------------------------------- /Data Assimilation Code/input/README.txt: -------------------------------------------------------------------------------- 1 | background file will be copied here by the data assimilation code 2 | -------------------------------------------------------------------------------- /Data Assimilation Code/mod_analysis.f90: -------------------------------------------------------------------------------- 1 | module mod_analysis 2 | use mod_params, only : output_pth, input_pth, N, NN, NLVLS, sub_y, sub_x, crt_bias, rgamma 3 | use mod_date 4 | use mod_read_data 5 | use mod_matrix_read 6 | use mod_matrix_W 7 | use mod_obs_sorting 8 | implicit none 9 | 10 | contains 11 | subroutine analysis(time) 12 | implicit none 13 | integer, intent(in) :: time(6) 14 | 15 | integer :: i, M2(2), M ! M = M2(1)+M2(2) 16 | integer, parameter :: NRECS = 1 17 | character :: tag*8 18 | real :: tmp4D(sub_x,sub_y,NLVLS,NRECS), tmp(sub_x,sub_y,NLVLS) 19 | real :: sal4D(sub_x,sub_y,NLVLS,NRECS), sal(sub_x,sub_y,NLVLS) 20 | real, allocatable :: tmp_o(:), sal_o(:), yo(:) 21 | real, allocatable :: H(:,:), HXb(:), W(:,:) 22 | real :: Xb(N), dX(N), bias(N) 23 | 24 | integer, allocatable :: Tindex3D(:,:), Sindex3D(:,:) 25 | 26 | real :: start, finish 27 | 28 | call cpu_time(start) 29 | 30 | ! (0) write date from observation time 31 | call date(tag,time) 32 | 33 | ! (1) get the number of observations 34 | write(*,*) 'Preparing observational data...' 35 | call sort_obs(M2,time) 36 | M = sum(M2) 37 | 38 | ! (2) compute gain matrix W 39 | write(*,*) 'Computing gain matrix...' 40 | call W_matrix(M2,M,time) 41 | 42 | ! (3) read in observation 43 | write(*,*) 'Updating the background with observational data...' 44 | 45 | allocate(tmp_o(M2(1)), sal_o(M2(2)), yo(M)) 46 | open(55,file='/home/chako/Argo/bias_nay/bins.dta',form='unformatted') 47 | read(55) tmp_o, sal_o 48 | close(55) 49 | yo(1:M2(1)) = tmp_o; yo(M2(1)+1:M) = sal_o 50 | write(*,*) '*** SUCCESS Sorted observation is read in!' 51 | 52 | ! (4) read in background 53 | open(55,file=input_pth//'background.dta',form='unformatted') 54 | read(55) tmp4D, sal4D 55 | close(55) 56 | tmp = tmp4D(:,:,:,1); sal = sal4D(:,:,:,1) 57 | write(*,*) '*** SUCCESS Background is read in!' 58 | 59 | call squeeze(Xb,tmp,sal) ! reshape tmp&sal to get Xb(N) 60 | 61 | ! (5) correct model bias 62 | if (crt_bias) then 63 | open(55,file=output_pth//'/bias/model_bias.dta',form='unformatted') 64 | read(55) bias 65 | close(55) 66 | write(*,*) '*** SUCCESS Model bias is read in!' 67 | 68 | Xb = Xb-bias 69 | endif 70 | 71 | ! (6) calculate increment 72 | allocate(H(M,N),HXb(M)) 73 | call readmatrix(H,M,N,'H',1) 74 | HXb = matmul(H,Xb) 75 | deallocate(H) 76 | ! IMPORTANT: find topography points in model output (=0.0): model topo points 77 | ! different from argo topo points 78 | do i=1,M 79 | if (HXb(i)==0.0) then 80 | yo(i) = 0.0 81 | endif 82 | enddo 83 | !!======================================================================== 84 | !! Check innovations !! 85 | allocate(Tindex3D(M2(1),4), Sindex3D(M2(2),4)) !! 86 | open(55,file='/home/chako/Argo/bias_nay/Index3D.dta',form='unformatted')!! 87 | read(55) Tindex3D, Sindex3D !! 88 | close(55) !! 89 | !! 90 | open(33,file='ensemble/check_innovation'//tag//'.txt',form='formatted') !! 91 | do i=1,M !! 92 | if (i<=M2(1)) then !! 93 | write(33,'(I3,I3,I3,I3,F24.16,F24.16)') Tindex3D(i,4),& !! 94 | Tindex3D(i,1), Tindex3D(i,2), Tindex3D(i,3), yo(i), HXb(i) !! 95 | else !! 96 | write(33,'(I3,I3,I3,I3,F24.16,F24.16)') Sindex3D(i-M2(1),4),& !! 97 | Sindex3D(i-M2(1),1),Sindex3D(i-M2(1),2),Sindex3D(i-M2(1),3),yo(i),HXb(i)!! 98 | endif !! 99 | enddo !! 100 | close(33) !! 101 | deallocate(Tindex3D, Sindex3D) !! 102 | !!======================================================================== 103 | yo = yo-HXb 104 | 105 | allocate(W(N/2,M)) 106 | call readmatrix(W,N/2,M,'WT',2) 107 | dX(1:N/2) = matmul(W,yo) 108 | call readmatrix(W,N/2,M,'WS',2) 109 | dX(N/2+1:N) = matmul(W,yo) 110 | deallocate(W) 111 | 112 | if (crt_bias) then 113 | bias = bias-rgamma*dX 114 | 115 | open(55,file=output_pth//'/bias/model_bias.dta',form='unformatted') 116 | write(55) bias 117 | close(55) 118 | write(*,*) '*** SUCCESS Model bias is updated!' 119 | endif 120 | 121 | ! (7) get analysis 122 | if ((maxval(dX(1:N/2))>10.0).or.(minval(dX(1:N/2))<-10.0)) then 123 | write(*,*) '*** WARNING T increment is abnormal!' 124 | write(*,*) '*** WARNING No observations assimilated!' 125 | Xb = Xb 126 | elseif ((maxval(dX(N/2+1:N))>5.0).or.(minval(dX(N/2+1:N))<-5.0)) then 127 | write(*,*) '*** WARNING S increment is abnormal!' 128 | write(*,*) '*** WARNING No observations assimilated!' 129 | Xb = Xb 130 | else 131 | Xb = Xb+dX ! acutally Xb=Xa 132 | endif 133 | call expand(tmp,sal,Xb) ! analysis of tmp & sal 134 | write(*,*) '*** SUCCESS Analysis is computed!' 135 | 136 | ! (8) save analysis as restart 137 | open(55,file=output_pth//'analysis'//tag//'.dta',form='unformatted') 138 | write(55) tmp, sal 139 | close(55) 140 | write(*,*) '*** SUCCESS Analysis is saved!' 141 | 142 | call cpu_time(finish) 143 | print '("Time = ",f10.2," minutes.")',(finish-start)/60.0 144 | 145 | return 146 | end subroutine analysis 147 | 148 | subroutine squeeze(var,var1,var2) 149 | implicit none 150 | real, intent(in) :: var1(sub_x,sub_y,NLVLS), var2(sub_x,sub_y,NLVLS) 151 | real, intent(out) :: var(N) 152 | integer :: i, j, k, r 153 | 154 | r = 0 155 | do k=1,NLVLS 156 | do j=1,sub_y 157 | do i=1,sub_x 158 | r = r+1 159 | var(r) = var1(i,j,k) 160 | enddo 161 | enddo 162 | enddo 163 | do k=1,NLVLS 164 | do j=1,sub_y 165 | do i=1,sub_x 166 | r = r+1 167 | var(r) = var2(i,j,k) 168 | enddo 169 | enddo 170 | enddo 171 | 172 | return 173 | end subroutine squeeze 174 | 175 | subroutine expand(var1,var2,var) 176 | implicit none 177 | real, intent(in) :: var(N) 178 | real, intent(out) :: var1(sub_x,sub_y,NLVLS), var2(sub_x,sub_y,NLVLS) 179 | integer :: i, j, k, r 180 | 181 | r = 0 182 | do k=1,NLVLS 183 | do j=1,sub_y 184 | do i=1,sub_x 185 | r = r+1 186 | var1(i,j,k) = var(r) 187 | enddo 188 | enddo 189 | enddo 190 | do k=1,NLVLS 191 | do j=1,sub_y 192 | do i=1,sub_x 193 | r = r+1 194 | var2(i,j,k) = var(r) 195 | enddo 196 | enddo 197 | enddo 198 | 199 | return 200 | end subroutine expand 201 | 202 | end module mod_analysis 203 | -------------------------------------------------------------------------------- /Data Assimilation Code/mod_date.f90: -------------------------------------------------------------------------------- 1 | module mod_date 2 | implicit none 3 | 4 | contains 5 | subroutine date(flag,times) 6 | implicit none 7 | integer, intent(in) :: times(6) 8 | character(len=8), intent(out) :: flag 9 | 10 | character :: year*4, month*2, day*2 11 | 12 | write(year,'(I4)') times(1) 13 | if (times(2)<10) then 14 | write(month,'(I1)') times(2) 15 | month = '0'//month 16 | else 17 | write(month,'(I2)') times(2) 18 | endif 19 | if (times(3)<10) then 20 | write(day,'(I1)') times(3) 21 | day = '0'//day 22 | else 23 | write(day,'(I2)') times(3) 24 | endif 25 | 26 | flag = year//month//day 27 | 28 | return 29 | end subroutine date 30 | 31 | end module mod_date 32 | -------------------------------------------------------------------------------- /Data Assimilation Code/mod_matrix_A.f90: -------------------------------------------------------------------------------- 1 | module mod_matrix_A 2 | use mod_params, only : data_pth, NLVLS, sub_y, sub_x, NS, DN, NN, N 3 | use mod_namelist 4 | use mod_read_data 5 | use mod_read_coor 6 | use mod_matrix_read 7 | use mod_matrix_write 8 | implicit none 9 | 10 | contains 11 | subroutine A_matrix() 12 | ! tmp7, sal7: 5-day mean 13 | ! tmp1, sal1: 1-day mean 14 | ! tmpp, salp: the anomalies with respect to the mean 15 | ! tmpd, sald: the deviation from the mean 16 | ! A(N,NN): ensemble matrix, N=NLVLS*sub_y*sub_x*2, NN is the ensemble number 17 | implicit none 18 | integer :: i, j, k, m, x, s, list 19 | character :: fname*15, fname2*18 20 | logical :: exist 21 | real :: tmp(sub_x,sub_y,NLVLS), sal(sub_x,sub_y,NLVLS) 22 | real :: tmps(sub_x,sub_y,NLVLS), sals(sub_x,sub_y,NLVLS) 23 | real :: tmpp(sub_x,sub_y,NLVLS), salp(sub_x,sub_y,NLVLS) 24 | real :: tmpd(sub_x,sub_y,NLVLS), sald(sub_x,sub_y,NLVLS) 25 | real, allocatable :: A(:,:), AT(:,:), AS(:,:) 26 | 27 | ! (0) initialize summation and std terms 28 | tmps = 0.0; sals = 0.0 29 | tmpd = 0.0; sald = 0.0 30 | 31 | ! (1) Write namelist.txt for the ensemble pool data files 32 | call namelists() 33 | 34 | ! (2) Get coordinates for T&S from a sample data file 35 | open (unit=15,file=data_pth//'namelist.txt', status='old', & 36 | access='sequential', form='formatted', action='read') 37 | read (15,'(A13)') fname 38 | close(15) 39 | fname2 = data_pth//fname 40 | call readcoor(fname2) 41 | 42 | ! (3) Construct Amean from every 6 day sampling of 2-year run 43 | OPEN (unit=15,file=data_pth//'namelist.txt', status='old', & 44 | access='sequential', form='formatted', action='read') 45 | 46 | m = 0 47 | s = 0 48 | do list=1,NS 49 | s = s+1 50 | read (15,'(A13)') fname 51 | if (s==DN) then 52 | fname2 = data_pth//fname 53 | call readdata(tmp,sal,fname2) 54 | 55 | tmps = tmps+tmp 56 | sals = sals+sal 57 | m = m+1 58 | s = 0 59 | endif 60 | enddo 61 | 62 | tmps = tmps/real(m) 63 | sals = sals/real(m) 64 | 65 | CLOSE(15) 66 | 67 | open(unit=12,file='ensemble/ensemble_mean_tmp.dta',form='unformatted') 68 | write(12) tmps 69 | close(12) 70 | open(unit=22,file='ensemble/ensemble_mean_sal.dta',form='unformatted') 71 | write(22) sals 72 | close(22) 73 | 74 | ! (4) Construct A'=A-Amean 75 | allocate(A(N,NN)) 76 | 77 | OPEN (unit=15,file=data_pth//'namelist.txt', status='old', & 78 | access='sequential', form='formatted', action='read') 79 | 80 | m = 0 81 | s = 0 82 | do list=1,NS 83 | s = s+1 84 | read (15,'(A13)') fname 85 | 86 | if (s==DN) then 87 | fname2 = data_pth//fname 88 | call readdata(tmp,sal,fname2) 89 | 90 | tmpp = tmp-tmps 91 | salp = sal-sals 92 | m = m+1 93 | s = 0 94 | 95 | x = 0 96 | do k = 1,NLVLS ! construct A' (NxNN) from Ai' (Nx1) 97 | do j = 1,sub_y 98 | do i = 1,sub_x 99 | x = x+1 100 | A(x,m) = tmpp(i,j,k) 101 | enddo 102 | enddo 103 | enddo 104 | do k = 1,NLVLS 105 | do j = 1,sub_y 106 | do i = 1,sub_x 107 | x = x+1 108 | A(x,m) = salp(i,j,k) 109 | enddo 110 | enddo 111 | enddo 112 | 113 | do k=1,NLVLS 114 | do j=1,sub_y 115 | do i=1,sub_x 116 | tmpd(i,j,k) = tmpd(i,j,k)+tmpp(i,j,k)**2.0 117 | sald(i,j,k) = sald(i,j,k)+salp(i,j,k)**2.0 118 | enddo 119 | enddo 120 | enddo 121 | endif 122 | enddo 123 | 124 | CLOSE(15) 125 | 126 | do k=1,NLVLS 127 | do j=1,sub_y 128 | do i=1,sub_x 129 | tmpd(i,j,k) = (tmpd(i,j,k)/real(m))**0.5 130 | sald(i,j,k) = (sald(i,j,k)/real(m))**0.5 131 | enddo 132 | enddo 133 | enddo 134 | 135 | open(unit=12,file='ensemble/ensemble_sprd_tmp.dta',form='unformatted') 136 | write(12) tmpd 137 | close(12) 138 | open(unit=22,file='ensemble/ensemble_sprd_sal.dta',form='unformatted') 139 | write(22) sald 140 | close(22) 141 | 142 | open(unit=11,file='ensemble/AT0matrix.dta',form='unformatted') 143 | do i=1,N/2 144 | write(11) (A(i,j),j=1,NN) 145 | enddo 146 | close(11) 147 | 148 | open(unit=11,file='ensemble/AS0matrix.dta',form='unformatted') 149 | do i=N/2+1,N 150 | write(11) (A(i,j),j=1,NN) 151 | enddo 152 | close(11) 153 | 154 | call writematrix(A,N,NN,'A',1) 155 | deallocate(A) 156 | 157 | allocate(AT(N/2,NN)) 158 | call readmatrix(AT,N/2,NN,'AT0',3,1) 159 | call writematrix(AT,N/2,NN,'AT',2) 160 | deallocate(AT) 161 | 162 | allocate(AS(N/2,NN)) 163 | call readmatrix(AS,N/2,NN,'AS0',3,1) 164 | call writematrix(AS,N/2,NN,'AS',2) 165 | deallocate(AS) 166 | 167 | stop 168 | end subroutine A_matrix 169 | 170 | end module mod_matrix_A 171 | -------------------------------------------------------------------------------- /Data Assimilation Code/mod_matrix_H.f90: -------------------------------------------------------------------------------- 1 | module mod_matrix_H 2 | use mod_params, only : N, NN 3 | use mod_matrix_read 4 | use mod_matrix_write 5 | implicit none 6 | 7 | contains 8 | subroutine H_matrix(M2,M) 9 | implicit none 10 | integer, intent(in) :: M2(2), M 11 | real, allocatable :: H(:,:), A(:,:), HA(:,:), HAT(:,:) 12 | real, allocatable :: AT(:,:), AHATT(:,:), AS(:,:), AHASS(:,:) 13 | real, allocatable :: AHAT1(:,:), AHAT2(:,:), AHAS1(:,:), AHAS2(:,:) 14 | 15 | integer :: i, j 16 | integer :: Tindex1D(M2(1)), Sindex1D(M2(2)) 17 | 18 | open(55,file='/home/chako/Argo/bias_nay/Index1D.dta',form='unformatted') 19 | read(55) Tindex1D, Sindex1D 20 | close(55) 21 | 22 | ! (1) compute matrix H 23 | allocate(H(M,N)) 24 | H = 0.0 25 | do i=1,M2(1) 26 | H(i,Tindex1D(i)) = 1.0 27 | enddo 28 | do i=M2(1)+1,M 29 | H(i,N/2+Sindex1D(i-M2(1))) = 1.0 30 | enddo 31 | 32 | call writematrix(H,M,N,'H',1) 33 | deallocate(H) 34 | 35 | ! (2) compute matrix HA 36 | allocate(A(N,NN), HA(M,NN)) 37 | call readmatrix(A,N,NN,'A',1) 38 | do j=1,NN 39 | do i=1,M2(1) 40 | HA(i,j) = A(Tindex1D(i),j) 41 | enddo 42 | enddo 43 | do j=1,NN 44 | do i=M2(1)+1,M 45 | HA(i,j) = A(N/2+Sindex1D(i-M2(1)),j) 46 | enddo 47 | enddo 48 | call writematrix(HA,M,NN,'HA',2) 49 | 50 | ! (3) compute matrix A(HAT): upper left and lower right 51 | allocate(HAT(NN,M)) 52 | HAT = transpose(HA) 53 | deallocate(A,HA) 54 | 55 | allocate(AT(N/2,NN),AHAT1(N/2,M2(1)),AHAT2(N/2,M2(2))) 56 | call readmatrix(AT,N/2,NN,'AT',2) 57 | AHAT1 = matmul(AT,HAT(:,1:M2(1))) 58 | call writematrix(AHAT1,N/2,M2(1),'AHAT1',5) 59 | AHAT2 = matmul(AT,HAT(:,M2(1)+1:M)) 60 | call writematrix(AHAT2,N/2,M2(2),'AHAT2',5) 61 | deallocate(AT,AHAT1,AHAT2) 62 | 63 | allocate(AS(N/2,NN),AHAS1(N/2,M2(1)),AHAS2(N/2,M2(2))) 64 | call readmatrix(AS,N/2,NN,'AS',2) 65 | AHAS1 = matmul(AS,HAT(:,1:M2(1))) 66 | call writematrix(AHAS1,N/2,M2(1),'AHAS1',5) 67 | AHAS2 = matmul(AS,HAT(:,M2(1)+1:M)) 68 | call writematrix(AHAS2,N/2,M2(2),'AHAS2',5) 69 | deallocate(AS,AHAS1,AHAS2,HAT) 70 | 71 | return 72 | end subroutine H_matrix 73 | 74 | end module mod_matrix_H 75 | -------------------------------------------------------------------------------- /Data Assimilation Code/mod_matrix_L.f90: -------------------------------------------------------------------------------- 1 | module mod_matrix_L 2 | use mod_params, only : NLVLS, sub_y, sub_x, N, loc_Lh, loc_Lv, Lh, Lv 3 | use mod_matrix_write 4 | use mod_matrix_read 5 | implicit none 6 | 7 | contains 8 | subroutine L_matrix(M2,M) 9 | implicit none 10 | integer, intent(in) :: M2(2), M 11 | real, allocatable :: LHT(:,:), HLHT(:,:) 12 | 13 | integer :: i, j, x, y, z 14 | integer :: p1(3), p2(3) 15 | integer :: Tindex1D(M2(1)), Sindex1D(M2(2)) 16 | integer :: Tindex3D(M2(1),4), Sindex3D(M2(2),4) 17 | 18 | real :: lons(sub_x,sub_y), lats(sub_x,sub_y), depth(NLVLS) 19 | real :: dh, dz 20 | 21 | open(unit=11,file='ensemble/coordinate.dta',form='unformatted') 22 | read(11) lons, lats, depth 23 | close(11) 24 | 25 | open(55,file='/home/chako/Argo/bias_nay/Index1D.dta',form='unformatted') 26 | read(55) Tindex1D, Sindex1D 27 | close(55) 28 | 29 | open(55,file='/home/chako/Argo/bias_nay/Index3D.dta',form='unformatted') 30 | read(55) Tindex3D, Sindex3D 31 | close(55) 32 | 33 | ! (1) compute LHT 34 | allocate(LHT(N,M)) 35 | LHT = 0.0 36 | i = 0 37 | do z=1,NLVLS 38 | do y=1,sub_y 39 | do x=1,sub_x 40 | i = i+1 41 | do j=1,M2(1) 42 | p1 = (/x,y,z/) 43 | p2 = (/Tindex3D(j,1),Tindex3D(j,2),Tindex3D(j,3)/) 44 | dh = hav_dis(lats(x,y),lons(x,y),lats(p2(1),p2(2)),lons(p2(1),p2(2))) 45 | dz = abs(depth(z)-depth(p2(3))) 46 | LHT(i,j) = corrcoef(dh,dz) 47 | enddo 48 | enddo 49 | enddo 50 | enddo 51 | do z=1,NLVLS 52 | do y=1,sub_y 53 | do x=1,sub_x 54 | i = i+1 55 | do j=1,M2(2) 56 | p1 = (/x,y,z/) 57 | p2 = (/Sindex3D(j,1),Sindex3D(j,2),Sindex3D(j,3)/) 58 | dh = hav_dis(lats(x,y),lons(x,y),lats(p2(1),p2(2)),lons(p2(1),p2(2))) 59 | dz = abs(depth(z)-depth(p2(3))) 60 | LHT(i,j+M2(1)) = corrcoef(dh,dz) 61 | enddo 62 | enddo 63 | enddo 64 | enddo 65 | LHT(N/2+1:N,1:M2(1)) = LHT(1:N/2,1:M2(1)) 66 | LHT(1:N/2,M2(1)+1:M) = LHT(N/2+1:N,M2(1)+1:M) 67 | 68 | open(55,file='ensemble/LHTT0matrix.dta',form='unformatted') 69 | do i=1,N/2 70 | write(55) (LHT(i,j), j=1,M2(1)) 71 | enddo 72 | close(55) 73 | 74 | open(55,file='ensemble/LHSS0matrix.dta',form='unformatted') 75 | do i=N/2+1,N 76 | write(55) (LHT(i,j), j=M2(1)+1,M) 77 | enddo 78 | close(55) 79 | 80 | ! (2) compute HLHT from H and LHT 81 | allocate(HLHT(M,M)) 82 | HLHT = 0.0 83 | do j=1,M 84 | do i=1,M2(1) 85 | HLHT(i,j) = LHT(Tindex1D(i),j) 86 | enddo 87 | enddo 88 | do j=1,M 89 | do i=M2(1)+1,M 90 | HLHT(i,j) = LHT(N/2+Sindex1D(i-M2(1)),j) 91 | enddo 92 | enddo 93 | 94 | call writematrix(HLHT,M,M,'HLHT',4) 95 | deallocate(LHT,HLHT) 96 | 97 | return 98 | end subroutine L_matrix 99 | 100 | real function corrcoef(L,D) 101 | implicit none 102 | real, intent(in) :: L, D ! horizontal distance: H; vertical distance: D 103 | real :: c 104 | 105 | if (loc_Lh .and. loc_Lv) then 106 | c = exp( -L**2.0/(2.0*(Lh**2.0)) - D**2.0/(2.0*(Lv**2.0)) ) 107 | elseif (loc_Lh .and. (loc_Lv == .false.)) then 108 | c = exp( -L**2.0/(2.0*(Lh**2.0))) 109 | elseif ((loc_Lh == .false.) .and. loc_Lv) then 110 | c = exp(- D**2.0/(2.0*(Lv**2.0))) 111 | else 112 | c = 1.0 113 | endif 114 | corrcoef = c 115 | 116 | return 117 | end function corrcoef 118 | 119 | real function hav_dis(lat1,lon1,lat2,lon2) 120 | implicit none 121 | real, intent(in) :: lat1, lon1, lat2, lon2 122 | real, parameter :: R = 6371.0, pi = 4.0*atan(1.0) 123 | real :: hav, dlat, dlon, rlat1, rlat2 124 | 125 | dlat = (lat1-lat2)*pi/180.0 126 | dlon = (lon1-lon2)*pi/180.0 127 | rlat1 = lat1*pi/180.0 128 | rlat2 = lat2*pi/180.0 129 | 130 | hav = 2.0*R*asin(sqrt( sin(dlat/2.0)**2.0+cos(rlat1)*cos(rlat2)*sin(dlon/2.0)**2.0 )) 131 | hav_dis = hav 132 | 133 | return 134 | end function hav_dis 135 | 136 | end module mod_matrix_L 137 | -------------------------------------------------------------------------------- /Data Assimilation Code/mod_matrix_R.f90: -------------------------------------------------------------------------------- 1 | module mod_matrix_R 2 | use mod_params, only : R_method, sigma_T1, sigma_S1, sigma_T2, Sigma_S2, kappa_T, kappa_S, sub_x, sub_y, NLVLS 3 | use mod_matrix_write 4 | implicit none 5 | 6 | contains 7 | subroutine R_matrix(M2,M) 8 | implicit none 9 | integer, intent (in) :: M2(2), M 10 | real, allocatable :: R(:,:) 11 | integer :: i, j 12 | 13 | real :: RT(NLVLS), RS(NLVLS) 14 | real :: T_std(sub_x,sub_y,NLVLS), S_std(sub_x,sub_y,NLVLS) 15 | integer :: Tindex3D(M2(1),4), Sindex3D(M2(2),4) 16 | 17 | allocate(R(M,M)) 18 | 19 | select case (R_method) 20 | 21 | ! I: R = const. + (factor*model_std)**2 22 | case(1) 23 | open(unit=12,file='ensemble/model_sprd_tmp.dta',form='unformatted') 24 | read(12) T_std 25 | close(12) 26 | 27 | open(unit=22,file='ensemble/model_sprd_sal.dta',form='unformatted') 28 | read(22) S_std 29 | close(22) 30 | 31 | open(55,file='/home/chako/Argo/bias_nay/Index3D.dta',form='unformatted') 32 | read(55) Tindex3D, Sindex3D 33 | close(55) 34 | 35 | do j = 1,M 36 | do i = 1,M 37 | if (i==j.and.i<=M2(1)) then 38 | R(i,j) = sigma_T1**2 + (kappa_T*& 39 | T_std(Tindex3D(i,1),Tindex3D(i,2),Tindex3D(i,3)))**2 40 | elseif (i==j.and.i>M2(1)) then 41 | R(i,j) = sigma_S1**2 + (kappa_S*& 42 | S_std(Sindex3D(i-M2(1),1),Sindex3D(i-M2(1),2),Sindex3D(i-M2(1),3)))**2 43 | else 44 | R(i,j) = 0.0 45 | endif 46 | enddo 47 | enddo 48 | 49 | ! II: R is constant 50 | case(2) 51 | do j = 1,M 52 | do i = 1,M 53 | if (i==j.and.i<=M2(1)) then 54 | R(i,j) = sigma_T2**2 55 | elseif (i==j.and.i>M2(1)) then 56 | R(i,j) = sigma_S2**2 57 | else 58 | R(i,j) = 0.0 59 | endif 60 | enddo 61 | enddo 62 | 63 | ! III: R is proportional to observation variance 64 | case(3) 65 | open(55,file='glider/Rmatrix.dta',form='unformatted',access='stream') 66 | read(55) RT, RS 67 | close(55) 68 | 69 | open(55,file='/home/chako/Argo/bias_nay/Index3D.dta',form='unformatted') 70 | read(55) Tindex3D, Sindex3D 71 | close(55) 72 | 73 | do j = 1,M 74 | do i = 1,M 75 | if (i==j.and.i<=M2(1)) then 76 | R(i,j) = RT(Tindex3D(i,3))/200.0 77 | elseif (i==j.and.i>M2(1)) then 78 | R(i,j) = RS(Sindex3D(i-M2(1),3))/2000.0 79 | else 80 | R(i,j) = 0.0 81 | endif 82 | enddo 83 | enddo 84 | end select 85 | 86 | call writematrix(R,M,M,'R',1) 87 | 88 | return 89 | end subroutine R_matrix 90 | 91 | end module mod_matrix_R 92 | -------------------------------------------------------------------------------- /Data Assimilation Code/mod_matrix_W.f90: -------------------------------------------------------------------------------- 1 | module mod_matrix_W 2 | use mod_params, only : N, NN, alpha, localize 3 | use mod_date 4 | use mod_matrix_read 5 | use mod_matrix_write 6 | use mod_matrix_inverse 7 | use mod_matrix_H 8 | use mod_matrix_L 9 | use mod_matrix_R 10 | implicit none 11 | 12 | contains 13 | subroutine W_matrix(M2,M,time) 14 | implicit none 15 | integer, intent(in) :: M2(2), M 16 | integer, intent(in) :: time(6) 17 | 18 | character :: tag*8 19 | real, allocatable :: WT(:,:), WS(:,:) 20 | real, allocatable :: AHAT1(:,:), AHAS1(:,:), AHAT2(:,:), AHAS2(:,:) 21 | real, allocatable :: LHTT(:,:), LHSS(:,:) 22 | 23 | real :: HA(M,NN), HAT(NN,M) 24 | real :: HLHT(M,M), R(M,M), W0(M,M), W2(M,M) 25 | 26 | integer :: i, Tindex3D(M2(1),4), Sindex3D(M2(2),4) 27 | 28 | ! (0) write date from observation time 29 | call date(tag,time) 30 | 31 | ! (1) compute & write H, HA, LHT, HLHT, R 32 | call H_matrix(M2,M) ! H(M,N), use 1D locations to compute H,HA,AHATT, AHASS 33 | call L_matrix(M2,M) ! LHT(N,M), use 3D locations to get LHTT, LHSS 34 | call R_matrix(M2,M) ! magnitude still needs to be determined 35 | 36 | ! (2) the second factor 37 | call readmatrix(HA,M,NN,'HA',2) ! HA(M,NN) 38 | HAT = transpose(HA) ! HAT(NN,M) 39 | W0 = matmul(HA,HAT) ! HA(M,NN) HAT(NN,M) --> W0(M,M) 40 | 41 | if (localize) then 42 | call readmatrix(HLHT,M,M,'HLHT',4) ! HLHT(M,M) 43 | W0 = HLHT*W0 44 | endif 45 | 46 | call readmatrix(R,M,M,'R',1) 47 | 48 | !!======================================================================== 49 | !! Check error variances !! 50 | open(55,file='/home/chako/Argo/bias_nay/Index3D.dta',form='unformatted')!! 51 | read(55) Tindex3D, Sindex3D !! 52 | close(55) !! 53 | !! 54 | open(33,file='ensemble/check_error_vari'//tag//'.txt',form='formatted') !! 55 | do i=1,M !! 56 | if (i<=M2(1)) then !! 57 | write(33,'(I3,I3,F24.16,F24.16)') Tindex3D(i,4), Tindex3D(i,3),& !! 58 | R(i,i), W0(i,i)*alpha/(NN-1) !! 59 | else !! 60 | write(33,'(I3,I3,F24.16,F24.16)') Sindex3D(i-M2(1),4),& !! 61 | Sindex3D(i-M2(1),3), R(i,i), W0(i,i)*alpha/(NN-1) !! 62 | endif !! 63 | enddo !! 64 | close(33) !! 65 | !!======================================================================== 66 | 67 | W0 = alpha*W0+(NN-1)*R ! W0(M,M) 68 | call inverse(W0,W2,M) ! W2(M,M) 69 | 70 | ! (3) the first factor 71 | ! the upper part of W: WT(N/2,M) 72 | allocate(AHAT1(N/2,M2(1))) 73 | call readmatrix(AHAT1,N/2,M2(1),'AHAT1',5) 74 | if (localize) then 75 | allocate(LHTT(N/2,M2(1))) 76 | call readmatrix(LHTT,N/2,M2(1),'LHTT0',5,1) 77 | AHAT1 = AHAT1*LHTT 78 | endif 79 | allocate(AHAT2(N/2,M2(2))) 80 | call readmatrix(AHAT2,N/2,M2(2),'AHAT2',5) 81 | if (localize) then 82 | allocate(LHSS(N/2,M2(2))) 83 | call readmatrix(LHSS,N/2,M2(2),'LHSS0',5,1) 84 | AHAT2 = AHAT2*LHSS 85 | endif 86 | 87 | allocate(WT(N/2,M)) 88 | WT(:,1:M2(1)) = AHAT1 89 | WT(:,M2(1)+1:M) = AHAT2 90 | deallocate(AHAT1,AHAT2) 91 | WT = matmul(WT,W2) 92 | WT = alpha*WT 93 | call writematrix(WT,N/2,M,'WT',2) 94 | deallocate(WT) 95 | 96 | ! the lower part of W: WS(N/2,M) 97 | allocate(AHAS1(N/2,M2(1))) 98 | call readmatrix(AHAS1,N/2,M2(1),'AHAS1',5) 99 | if (localize) then 100 | AHAS1 = AHAS1*LHTT 101 | deallocate(LHTT) 102 | endif 103 | allocate(AHAS2(N/2,M2(2))) 104 | call readmatrix(AHAS2,N/2,M2(2),'AHAS2',5) 105 | if (localize) then 106 | AHAS2 = AHAS2*LHSS 107 | deallocate(LHSS) 108 | endif 109 | 110 | allocate(WS(N/2,M)) 111 | WS(:,1:M2(1)) = AHAS1 112 | WS(:,M2(1)+1:M) = AHAS2 113 | deallocate(AHAS1,AHAS2) 114 | WS = matmul(WS,W2) 115 | WS = alpha*WS 116 | call writematrix(WS,N/2,M,'WS',2) 117 | deallocate(WS) 118 | 119 | return 120 | end subroutine W_matrix 121 | 122 | end module mod_matrix_W 123 | -------------------------------------------------------------------------------- /Data Assimilation Code/mod_matrix_inverse.f90: -------------------------------------------------------------------------------- 1 | module mod_matrix_inverse 2 | implicit none 3 | 4 | contains 5 | subroutine inverse(a,c,n) 6 | !============================================================ 7 | ! Inverse matrix 8 | ! Method: Based on Doolittle LU factorization for Ax=b 9 | ! Alex G. December 2009 10 | !----------------------------------------------------------- 11 | ! input ... 12 | ! a(n,n) - array of coefficients for matrix A 13 | ! n - dimension 14 | ! output ... 15 | ! c(n,n) - inverse matrix of A 16 | ! comments ... 17 | ! the original matrix a(n,n) will be destroyed 18 | ! during the calculation 19 | !=========================================================== 20 | implicit none 21 | integer, intent(in) :: n 22 | real :: a(n,n) 23 | real :: c(n,n) 24 | integer :: i, j, k 25 | real :: L(n,n), U(n,n), b(n), d(n), x(n) 26 | real :: coeff 27 | 28 | ! step 0: initialization for matrices L and U and b 29 | ! Fortran 90/95 aloows such operations on matrices 30 | L=0.0 31 | U=0.0 32 | b=0.0 33 | 34 | ! step 1: forward elimination 35 | do k=1, n-1 36 | do i=k+1,n 37 | coeff=a(i,k)/a(k,k) 38 | L(i,k) = coeff 39 | do j=k+1,n 40 | a(i,j) = a(i,j)-coeff*a(k,j) 41 | enddo 42 | enddo 43 | enddo 44 | 45 | ! Step 2: prepare L and U matrices 46 | ! L matrix is a matrix of the elimination coefficient 47 | ! + the diagonal elements are 1.0 48 | do i=1,n 49 | L(i,i) = 1.0 50 | enddo 51 | ! U matrix is the upper triangular part of A 52 | do j=1,n 53 | do i=1,j 54 | U(i,j) = a(i,j) 55 | enddo 56 | enddo 57 | 58 | ! Step 3: compute columns of the inverse matrix C 59 | do k=1,n 60 | b(k)=1.0 61 | d(1) = b(1) 62 | ! Step 3a: Solve Ld=b using the forward substitution 63 | do i=2,n 64 | d(i)=b(i) 65 | do j=1,i-1 66 | d(i) = d(i)-L(i,j)*d(j) 67 | enddo 68 | enddo 69 | ! Step 3b: Solve Ux=d using the back substitution 70 | x(n)=d(n)/U(n,n) 71 | do i = n-1,1,-1 72 | x(i) = d(i) 73 | do j=n,i+1,-1 74 | x(i)=x(i)-U(i,j)*x(j) 75 | enddo 76 | x(i) = x(i)/u(i,i) 77 | enddo 78 | ! Step 3c: fill the solutions x(n) into column k of C 79 | do i=1,n 80 | c(i,k) = x(i) 81 | enddo 82 | b(k)=0.0 83 | enddo 84 | 85 | return 86 | 87 | end subroutine inverse 88 | 89 | end module mod_matrix_inverse 90 | -------------------------------------------------------------------------------- /Data Assimilation Code/mod_matrix_read.f90: -------------------------------------------------------------------------------- 1 | module mod_matrix_read 2 | implicit none 3 | 4 | contains 5 | subroutine readmatrix(matrix,dim1,dim2,mat_name,name_length,opt) 6 | implicit none 7 | integer, intent(in) :: name_length 8 | integer, intent(in) :: dim1, dim2 9 | character, intent(in) :: mat_name*name_length 10 | real, intent(out) :: matrix(dim1,dim2) 11 | integer, intent(in), optional :: opt 12 | 13 | integer :: i, j 14 | 15 | write(*,*) "*** Reading matrix "//mat_name//"..." 16 | 17 | open(unit=11,file='ensemble/'//mat_name//'matrix.dta',form='unformatted') 18 | if (present(opt)) then 19 | do i=1,dim1 20 | read(11) (matrix(i,j),j=1,dim2) 21 | enddo 22 | else 23 | read(11) matrix 24 | endif 25 | close(11) 26 | 27 | write(*,*) " ...done." 28 | 29 | return 30 | end subroutine readmatrix 31 | 32 | end module mod_matrix_read 33 | -------------------------------------------------------------------------------- /Data Assimilation Code/mod_matrix_write.f90: -------------------------------------------------------------------------------- 1 | module mod_matrix_write 2 | implicit none 3 | 4 | contains 5 | subroutine writematrix(matrix,dim1,dim2,mat_name,name_length) 6 | implicit none 7 | integer, intent(in) :: dim1, dim2 8 | real, intent(in) :: matrix(dim1,dim2) 9 | integer, intent(in) :: name_length 10 | character, intent(in) :: mat_name*name_length 11 | 12 | write(*,*) "*** Writing matrix "//mat_name//"..." 13 | 14 | open(unit=11,file='ensemble/'//mat_name//'matrix.dta',form='unformatted') 15 | write(11) matrix 16 | close(11) 17 | 18 | write(*,*) " ...done." 19 | 20 | return 21 | end subroutine writematrix 22 | 23 | end module mod_matrix_write 24 | -------------------------------------------------------------------------------- /Data Assimilation Code/mod_namelist.f90: -------------------------------------------------------------------------------- 1 | module mod_namelist 2 | use mod_params, only : y_start, y_end, fname_var, data_pth, NS 3 | implicit none 4 | 5 | contains 6 | subroutine namelists() 7 | implicit none 8 | integer :: y, m, d, n 9 | logical :: exist 10 | character(len=13) :: fname, fnames(NS) 11 | character :: fname2*18 12 | character :: year*4, month*2, day*2 13 | 14 | n = 0 15 | do y=y_start,y_end 16 | do m=1,12 17 | do d=1,31 18 | write (year,'(I4)') y 19 | 20 | if (m<10) then 21 | write(month,'(I1)') m 22 | month = '0'//month(1:1) 23 | else 24 | write(month,'(I2)') m 25 | endif 26 | 27 | if (d<10) then 28 | write(day,'(I1)') d 29 | day = '0'//day(1:1) 30 | else 31 | write(day,'(I2)') d 32 | endif 33 | 34 | fname = year//month//day//fname_var 35 | 36 | fname2 = data_pth//fname 37 | inquire(file=fname2,exist=exist) 38 | if (exist.eqv..true.) then 39 | n = n+1 40 | fnames(n) = fname 41 | endif 42 | 43 | enddo 44 | enddo 45 | enddo 46 | 47 | open (unit=15,file='data/namelist.txt', status='new', & 48 | access='sequential', form='formatted', action='write') 49 | do n=1,NS 50 | write (15,'(A13)') fnames(n) 51 | enddo 52 | close(15) 53 | 54 | return 55 | end subroutine namelists 56 | 57 | end module mod_namelist 58 | -------------------------------------------------------------------------------- /Data Assimilation Code/mod_obs_sorting.f90: -------------------------------------------------------------------------------- 1 | module mod_obs_sorting 2 | use mod_params, only : max_argo, N, sub_x, sub_y, NLVLS 3 | use mod_obs_superobing 4 | implicit none 5 | 6 | contains 7 | subroutine sort_obs(M2,time) 8 | implicit none 9 | integer, intent(in) :: time(6) 10 | integer, intent(out) :: M2(2) ! # of T&S observations 11 | 12 | character :: filename*14 13 | integer :: argos ! total number of argo profiles 14 | integer :: loc(2) ! loc(2)=(lon or i) and (lat or j) 15 | integer :: lvl(2) ! # of stacks of bins of T & S 16 | 17 | integer, allocatable :: locs(:,:) ! horizontal locations of argo profiles 18 | integer, allocatable :: Mt(:), Ms(:) ! numbers of T&S in each argo profile 19 | logical :: exist 20 | 21 | integer, allocatable :: index1D(:), index3D(:,:) ! indices of obs in 1D/3D model grids 22 | integer, allocatable :: Tindex1Ds(:), Sindex1Ds(:) ! indices of obs in 1D model grids 23 | integer, allocatable :: Tindex3Ds(:,:), Sindex3Ds(:,:) ! indices of obs in 3D model grids 24 | integer, allocatable :: lvl_t(:), lvl_s(:) ! # of bins of T and S 25 | real, allocatable :: tmp(:), sal(:) ! T&S from 1 Argo 26 | real, allocatable :: tmps(:), sals(:) ! T&S from all Argo 27 | 28 | integer :: i, j, k, p, ind1, ind2 29 | 30 | ! (1) check the number of the argo profiles on 'date' 31 | argos = 0 32 | do p=1,max_argo 33 | call argo_name(filename,time,p) 34 | inquire(file='/home/chako/Argo/daily/'//filename,exist=exist) 35 | if (exist.eqv..true.) then 36 | argos = argos+1 37 | else 38 | exit 39 | endif 40 | 41 | enddo 42 | 43 | if (argos==0) then 44 | write(*,*) "*** STOP No Argo profile is read in." 45 | stop 46 | else 47 | write(*,*) argos, 'Argo profiles are read in.' 48 | endif 49 | 50 | ! (2) read in all argos and record horizontal indices and numbers of bins 51 | allocate(locs(argos,2),Mt(argos),Ms(argos)) 52 | 53 | do p=1,argos 54 | call argo_name(filename,time,p) 55 | call bins(loc,lvl,filename) 56 | locs(p,1) = loc(1) ! location: loc(n,1)=lon=i 57 | locs(p,2) = loc(2) ! location: loc(n,2)=lat=j 58 | Mt(p) = lvl(1) ! number of T 59 | Ms(p) = lvl(2) ! numbers of S 60 | enddo 61 | 62 | M2(1) = sum(Mt); M2(2) = sum(Ms) 63 | if (sum(M2)==0) stop "*** STOP No T and S is read in!" 64 | if (M2(1)==0) write(*,*) "*** WARNING No T is read in!" 65 | if (M2(2)==0) write(*,*) "*** WARNING No S is read in!" 66 | write(*,'(A45,I3,A1,I3,A1)')'*** SUCCESS Numbers of the bins of T, S are ',M2(1),',',M2(2),'!' 67 | allocate(Tindex1Ds(M2(1)), Tindex3Ds(M2(1),4), tmps(M2(1))) 68 | allocate(Sindex1Ds(M2(2)), Sindex3Ds(M2(2),4), sals(M2(2))) 69 | 70 | ! (3) read in the obs and rearrange T&S, along with their 1D&3D indices 71 | ! (3.1) First, combine T from all Argos 72 | ind2 = 0 73 | do p=1,argos 74 | 75 | if (Mt(p)==0) cycle 76 | 77 | allocate(lvl_t(Mt(p)), tmp(Mt(p))) 78 | allocate(index1D(Mt(p)), index3D(Mt(p),4)) 79 | 80 | call argo_name(filename,time,p) 81 | open(55,file='/home/chako/Argo/bias_nay/bins'//filename,form='unformatted') 82 | read(55) lvl_t, tmp 83 | close(55) 84 | 85 | do k=1,Mt(p) 86 | index1D(k) = sub_x*sub_y*(lvl_t(k)-1)+sub_x*(locs(p,2)-1)+locs(p,1) 87 | if (index1D(k)>N/2) stop "*** ERROR 1D index of T greater than N/2!" 88 | index3D(k,1) = locs(p,1) 89 | index3D(k,2) = locs(p,2) 90 | index3D(k,3) = lvl_t(k) 91 | index3D(k,4) = p 92 | enddo 93 | ind1 = ind2+1 94 | ind2 = ind2+k-1 95 | Tindex1Ds(ind1:ind2) = index1D 96 | Tindex3Ds(ind1:ind2,:) = index3D 97 | tmps(ind1:ind2) = tmp 98 | 99 | deallocate(lvl_t,tmp) 100 | deallocate(index1D,index3D) 101 | enddo 102 | 103 | ! (3.2) Second, combine S from all argos 104 | ind2 = 0 105 | do p=1,argos 106 | 107 | if (Ms(p)==0) cycle 108 | 109 | allocate(lvl_t(Mt(p)), tmp(Mt(p))) 110 | allocate(lvl_s(Ms(p)), sal(Ms(p))) 111 | allocate(index1D(Ms(p)), index3D(Ms(p),4)) 112 | 113 | call argo_name(filename,time,p) 114 | open(55,file='/home/chako/Argo/bias_nay/bins'//filename,form='unformatted') 115 | read(55) lvl_t, tmp, lvl_s, sal 116 | close(55) 117 | 118 | do k=1,Ms(p) 119 | index1D(k) = sub_x*sub_y*(lvl_s(k)-1)+sub_x*(locs(p,2)-1)+locs(p,1) 120 | if (index1D(k)>N/2) stop "*** ERROR 1D index of S greater than N/2!" 121 | index3D(k,1) = locs(p,1) 122 | index3D(k,2) = locs(p,2) 123 | index3D(k,3) = lvl_s(k) 124 | index3D(k,4) = p 125 | enddo 126 | ind1 = ind2+1 127 | ind2 = ind2+k-1 128 | Sindex1Ds(ind1:ind2) = index1D 129 | Sindex3Ds(ind1:ind2,:) = index3D 130 | sals(ind1:ind2) = sal 131 | 132 | deallocate(lvl_t,tmp) 133 | deallocate(lvl_s,sal) 134 | deallocate(index1D,index3D) 135 | enddo 136 | 137 | ! (4) sort obs_Index, tmpn and saln acording to obs_Index1D 138 | call sort(Tindex1Ds,Tindex3Ds,tmps,M2(1)) 139 | call sort(Sindex1Ds,Sindex3Ds,sals,M2(2)) 140 | 141 | open(55,file='/home/chako/Argo/bias_nay/Index1D.dta',form='unformatted') 142 | write(55) Tindex1Ds, Sindex1Ds 143 | close(55) 144 | open(55,file='/home/chako/Argo/bias_nay/Index3D.dta',form='unformatted') 145 | write(55) Tindex3Ds, Sindex3Ds 146 | close(55) 147 | write(*,*) '*** SUCCESS Indices of observations are written!' 148 | 149 | open(55,file='/home/chako/Argo/bias_nay/bins.dta',form='unformatted') 150 | write(55) tmps, sals 151 | close(55) 152 | write(*,*) '*** SUCCESS Sorted data for all argos are written!' 153 | return 154 | end subroutine sort_obs 155 | 156 | !======================================================================================== 157 | subroutine argo_name(argoname,date,tag) 158 | implicit none 159 | character, intent(out) :: argoname*14 160 | integer, intent(in) :: date(3) 161 | integer, intent(in) :: tag 162 | 163 | character :: year*4, month*2, day*2, tags*2 164 | 165 | write(year,'(I4)') date(1) 166 | 167 | if (date(2)<10) then 168 | write(month,'(I1)') date(2) 169 | month = '0'//month(1:1) 170 | else 171 | write(month,'(I2)') date(2) 172 | endif 173 | 174 | if (date(3)<10) then 175 | write(day,'(I1)') date(3) 176 | day = '0'//day(1:1) 177 | else 178 | write(day,'(I2)') date(3) 179 | endif 180 | 181 | if (tag<10) then 182 | write(tags,'(I1)') tag 183 | tags = '0'//tags(1:1) 184 | else 185 | write(tags,'(I2)') tag 186 | endif 187 | 188 | argoname = year//month//day//tags//'.dta' 189 | 190 | return 191 | end subroutine argo_name 192 | 193 | !======================================================================================== 194 | subroutine sort(Index1D,Index3D,var,recs) 195 | implicit none 196 | integer, intent(in) :: recs 197 | integer, intent(inout) :: Index1D(recs) 198 | integer, intent(inout) :: Index3D(recs,4) 199 | real, intent(inout) :: var(recs,2) 200 | integer :: i, location 201 | 202 | do i=1,recs-1 203 | location = FindMinimum(Index1D,i,recs) 204 | call swap_int(Index1D(i),Index1D(location)) 205 | 206 | call swap_int(Index3D(i,1),Index3D(location,1)) 207 | call swap_int(Index3D(i,2),Index3D(location,2)) 208 | call swap_int(Index3D(i,3),Index3D(location,3)) 209 | call swap_int(Index3D(i,4),Index3D(location,4)) 210 | 211 | call swap_real(var(i,1),var(location,1)) 212 | enddo 213 | 214 | return 215 | end subroutine sort 216 | 217 | !======================================================================================== 218 | integer function FindMinimum(x,start,final) 219 | implicit none 220 | integer, intent(in) :: x(1:) 221 | integer, intent(in) :: start, final 222 | integer :: minimum, location, i 223 | 224 | minimum = x(start) 225 | location = start 226 | do i=start+1,final 227 | if (x(i)=(dpt_m(k-1)+dpt_m(k))/2.0.and.& 84 | dpt_o_min<(dpt_m(k)+dpt_m(k+1))/2.0) then 85 | lvl(1) = k 86 | exit 87 | endif 88 | enddo 89 | if (lvl(1)<0.and.dpt_o_min<(dpt_m(1)+dpt_m(2))/2.0) lvl(1) = 1 90 | if (lvl(1)<0.and.dpt_o_min>=(dpt_m(NLVLS-1)+dpt_m(NLVLS))/2.0) lvl(1) = NLVLS 91 | 92 | do k=2,NLVLS-1 93 | if (dpt_o_max>=(dpt_m(k-1)+dpt_m(k))/2.0.and.& 94 | dpt_o_max<(dpt_m(k)+dpt_m(k+1))/2.0) then 95 | lvl(2) = k 96 | exit 97 | endif 98 | enddo 99 | if (lvl(2)<0.and.dpt_o_max<(dpt_m(1)+dpt_m(2))/2.0) lvl(2) = 1 100 | if (lvl(2)<0.and.dpt_o_max>=(dpt_m(NLVLS-1)+dpt_m(NLVLS))/2.0) lvl(2) = NLVLS 101 | 102 | if (product(lvl)<0) stop "*** Error in finding vertial bins!" 103 | 104 | !-------------------------------------------------------------------------------------- 105 | ! (2) compute the profile/bins of tmp and sal 106 | lvls = lvl(2)-lvl(1)+1 107 | allocate(tmp(lvls),sal(lvls)) 108 | 109 | ! (2.1) compute the mean of T&S in each bin 110 | z = 0; tmp = 0.0; sal = 0.0 111 | do k=lvl(1),lvl(2) 112 | z = z+1 113 | 114 | mt = 0; ms = 0 115 | if (k==1) then 116 | do i=1,recs 117 | if (dpts_o(i)<(dpt_m(k)+dpt_m(k+1))/2.0) then 118 | if (isnan(tmps(i)).eq..false.) then 119 | mt = mt+1 120 | tmp(z) = tmp(z)+tmps(i) 121 | endif 122 | if (isnan(sals(i)).eq..false.) then 123 | ms = ms+1 124 | sal(z) = sal(z)+sals(i) 125 | endif 126 | endif 127 | enddo 128 | elseif (k==NLVLS) then 129 | do i=1,recs 130 | if (dpts_o(i)>=(dpt_m(k-1)+dpt_m(k))/2.0) then 131 | if (isnan(tmps(i)).eq..false.) then 132 | mt = mt+1 133 | tmp(z) = tmp(z)+tmps(i) 134 | endif 135 | if (isnan(sals(i)).eq..false.) then 136 | ms = ms+1 137 | sal(z) = sal(z)+sals(i) 138 | endif 139 | endif 140 | enddo 141 | else 142 | do i=1,recs 143 | if (dpts_o(i)>=(dpt_m(k-1)+dpt_m(k))/2.0.and.& 144 | dpts_o(i)<(dpt_m(k)+dpt_m(k+1))/2.0) then 145 | if (isnan(tmps(i)).eq..false.) then 146 | mt = mt+1 147 | tmp(z) = tmp(z)+tmps(i) 148 | endif 149 | if (isnan(sals(i)).eq..false.) then 150 | ms = ms+1 151 | sal(z) = sal(z)+sals(i) 152 | endif 153 | endif 154 | enddo 155 | endif 156 | 157 | tmp(z) = tmp(z)/real(mt) 158 | sal(z) = sal(z)/real(ms) 159 | enddo 160 | 161 | ! (2.2) find and save the bins that are not NaNs 162 | mt = 0; ms = 0 163 | do k=1,lvls 164 | if (isnan(tmp(k)).eq..false.) then 165 | mt = mt+1 166 | endif 167 | if (isnan(sal(k)).eq..false.) then 168 | ms = ms+1 169 | endif 170 | enddo 171 | 172 | allocate(tmp_save(mt),sal_save(ms),lvl_t(mt),lvl_s(ms)) 173 | mt = 0; ms = 0; z = 0 174 | do k=lvl(1),lvl(2) 175 | z = z+1 176 | if (isnan(tmp(z)).eq..false.) then 177 | mt = mt+1 178 | lvl_t(mt) = k 179 | tmp_save(mt) = tmp(z) 180 | endif 181 | if (isnan(sal(z)).eq..false.) then 182 | ms = ms+1 183 | lvl_s(ms) = k 184 | sal_save(ms) = sal(z) 185 | endif 186 | enddo 187 | 188 | lvl(1) = mt ! number of bins with T values 189 | lvl(2) = ms ! number of bins with S values 190 | 191 | !-------------------------------------------------------------------------------------- 192 | ! (3) save the bins with size of lvl(1) for T and lvl(2) for S 193 | open(55,file='/home/chako/Argo/bias_nay/bins'//filename,form='unformatted') 194 | write(55) lvl_t, tmp_save, lvl_s, sal_save 195 | close(55) 196 | write(*,*) '*** SUCCESS Unsorted Argo data for '//filename//' is written!' 197 | 198 | deallocate(tmp,sal,tmp_save,sal_save,lvl_t,lvl_s) 199 | 200 | return 201 | end subroutine bins 202 | 203 | !======================================================================================== 204 | real function mean(x,n) 205 | implicit none 206 | integer, intent(in) :: n 207 | real, intent(in) :: x(n) 208 | integer :: i, n2 209 | real :: m 210 | 211 | m = 0.0; n2 = 0 212 | do i=1,n 213 | if (isnan(x(i)).eq..false.) then 214 | n2=n2+1 215 | m=m+x(i) 216 | endif 217 | enddo 218 | m = m/real(n2) 219 | mean = m 220 | 221 | return 222 | end function mean 223 | 224 | !======================================================================================== 225 | real function std(x,n) 226 | implicit none 227 | integer, intent(in) :: n 228 | real, intent(in) :: x(n) 229 | integer :: i, n2 230 | real :: s, m 231 | 232 | m = mean(x,n) 233 | s = 0.0; n2 = 0 234 | do i=1,n 235 | if (isnan(x(i)).eq..false.) then 236 | n2=n2+1 237 | s=s+(x(i)-m)**2.0 238 | endif 239 | enddo 240 | s = sqrt(s/real(n2)) 241 | std = s 242 | 243 | return 244 | end function std 245 | 246 | end module mod_obs_superobing 247 | -------------------------------------------------------------------------------- /Data Assimilation Code/mod_params.f90: -------------------------------------------------------------------------------- 1 | module mod_params 2 | implicit none 3 | 4 | !********************************* Data Assimilation Step Options ********************************* 5 | character (len=*), parameter :: output_pth = 'output/' ! analysis file 6 | character (len=*), parameter :: input_pth = 'input/' ! background file 7 | character (len=*), parameter :: data_pth = 'data/' ! ensemble files 8 | character (len=*), parameter :: fname_var = '_T.nc' ! suffix of ensemble files 9 | 10 | logical, parameter :: step = .false. ! .T. to construct ensemble 11 | integer, parameter :: y_start = 2012 ! first year of ensemble data pool 12 | integer, parameter :: y_end = 2014 ! last year of ensemble data pool 13 | integer, parameter :: NN = 121 ! size of ensemble (5 days per month from 2-year) 14 | integer, parameter :: NS = 730 ! size of ensemble pool 15 | integer, parameter :: DN = 6 ! step interval to sample the ensemble pool 16 | 17 | logical, parameter :: localize = .true. ! .T. for using localization 18 | logical, parameter :: loc_Lh = .true. ! .T. for using horizontal localization 19 | logical, parameter :: loc_Lv = .true. ! .T. for using vertical localization 20 | real, parameter :: Lh = 100.0 ! km, horizontal localization scale 21 | real, parameter :: Lv = 750.0 ! m, vertical localization scale 22 | real, parameter :: alpha = 0.001 ! scaling parameter of matrix B 23 | 24 | logical, parameter :: crt_bias = .false. ! .T. to correct model bias 25 | real, parameter :: rgamma = 0.01 ! scaling parameter of model bias 26 | 27 | !************************************* Info about Argo Data *************************************** 28 | integer, parameter :: max_argo = 2 ! max number of argo to assimilate 29 | integer, parameter :: R_method = 2 ! 1 or 2 to select method for R 30 | ! R_method=1 31 | real, parameter :: sigma_T1 = 1.0 ! instrument error: std of T (C) 32 | real, parameter :: sigma_S1 = 0.05 ! instrument error: std of S (PSU) 33 | real, parameter :: kappa_T = 0.5 ! coef of representative error 34 | real, parameter :: kappa_S = 0.5 ! coef of representative error 35 | ! R_method=2 36 | real, parameter :: sigma_T2 = 0.5 ! constant error 37 | real, parameter :: sigma_S2 = 0.1 ! constant error 38 | 39 | !*********************************** Info on NEMO Output Data ************************************* 40 | character (len=*), parameter :: REC_NAME = 'time_counter' 41 | character (len=*), parameter :: LVL_NAME = 'deptht' 42 | character (len=*), parameter :: LAT_NAME = 'nav_lat' 43 | character (len=*), parameter :: LON_NAME = 'nav_lon' 44 | character (len=*), parameter :: TMP_NAME = 'votemper' 45 | character (len=*), parameter :: SAL_NAME = 'vosaline' 46 | 47 | integer, parameter :: NDIMS = 4, NRECS = 1 ! 4-D variables, 1 time record 48 | integer, parameter :: NLVLS = 50, NLATS = 616, NLONS = 709 ! (k,j,i)=(50,616,709) 49 | 50 | !************************************* DA Subdomain Setting *************************************** 51 | integer, parameter :: sub_xy(4) = (/1, 106, 443, 616/) ! start and end points in x and y 52 | integer, parameter :: sub_x = 443, sub_y = 511 ! number of points in x-lon and y-lat 53 | integer, parameter :: N = NLVLS*sub_x*sub_y*2 ! number of model grid points of T, S 54 | 55 | end module mod_params 56 | -------------------------------------------------------------------------------- /Data Assimilation Code/mod_read_coor.f90: -------------------------------------------------------------------------------- 1 | module mod_read_coor 2 | use netcdf 3 | use mod_params, only : NLONS, NLATS, NLVLS, LON_NAME, LAT_NAME, LVL_NAME, sub_x, sub_y, sub_xy 4 | implicit none 5 | 6 | contains 7 | subroutine readcoor(fname2) 8 | implicit none 9 | character (len=18), intent(in) :: fname2 10 | 11 | integer :: ncid 12 | integer :: lat_varid, lon_varid, lvl_varid 13 | real :: lons(NLONS,NLATS), lats(NLONS,NLATS), depth(NLVLS) ! reversed order 14 | real :: lons2(sub_x,sub_y), lats2(sub_x,sub_y) 15 | 16 | ! (1) Open the file. 17 | call check( nf90_open(fname2, nf90_nowrite, ncid) ) 18 | 19 | ! (2) Get the varids of longitude, latitude and depth 20 | call check( nf90_inq_varid(ncid, LON_NAME, lon_varid) ) 21 | call check( nf90_inq_varid(ncid, LAT_NAME, lat_varid) ) 22 | call check( nf90_inq_varid(ncid, LVL_NAME, lvl_varid) ) 23 | 24 | ! (3) Read longitude and latitude data 25 | call check( nf90_get_var(ncid, lon_varid, lons) ) 26 | call check( nf90_get_var(ncid, lat_varid, lats) ) 27 | call check( nf90_get_var(ncid, lvl_varid, depth) ) 28 | 29 | ! (4) Close the file 30 | call check( nf90_close(ncid) ) 31 | 32 | ! (5) Write out the coordinates 33 | lons2 = lons(sub_xy(1):sub_xy(3),sub_xy(2):sub_xy(4)) 34 | lats2 = lats(sub_xy(1):sub_xy(3),sub_xy(2):sub_xy(4)) 35 | open(unit=11,file='ensemble/coordinate.dta',form='unformatted') 36 | write(11) lons2, lats2, depth 37 | close(11) 38 | 39 | write(*,*) "*** SUCCESS Coordinate is written!" 40 | 41 | return 42 | end subroutine readcoor 43 | 44 | subroutine check(status) 45 | integer, intent (in) :: status 46 | 47 | if (status /= nf90_noerr) then 48 | print *, trim(nf90_strerror(status)) 49 | stop "Stopped" 50 | endif 51 | 52 | return 53 | end subroutine check 54 | 55 | end module mod_read_coor 56 | -------------------------------------------------------------------------------- /Data Assimilation Code/mod_read_data.f90: -------------------------------------------------------------------------------- 1 | module mod_read_data 2 | use netcdf 3 | use mod_params, only :NLONS, NLATS, NLVLS, NDIMS, NRECS, TMP_NAME, SAL_NAME, sub_x, sub_y, sub_xy 4 | implicit none 5 | 6 | contains 7 | subroutine readdata(tmp2,sal2,fname2) 8 | implicit none 9 | character(len=18), intent(in) :: fname2 10 | real, intent(out) :: tmp2(sub_x, sub_y, NLVLS) 11 | real, intent(out) :: sal2(sub_x, sub_y, NLVLS) 12 | 13 | real :: tmp(NLONS, NLATS, NLVLS) 14 | real :: sal(NLONS, NLATS, NLVLS) 15 | 16 | integer :: ncid, rec 17 | integer :: start(NDIMS), count(NDIMS) 18 | integer :: tmp_varid, sal_varid 19 | 20 | ! (1) Open the file 21 | call check( nf90_open(fname2, nf90_nowrite, ncid) ) 22 | 23 | ! (2) Get the varids of T and S 24 | call check( nf90_inq_varid(ncid, TMP_NAME, tmp_varid) ) 25 | call check( nf90_inq_varid(ncid, SAL_NAME, sal_varid) ) 26 | 27 | ! (3) Read T and S from the file, 1 record at a time 28 | count = (/ NLONS, NLATS, NLVLS, 1 /) 29 | start = (/ 1, 1, 1, 1 /) 30 | do rec = 1, NRECS 31 | start(4) = rec 32 | call check( nf90_get_var(ncid, tmp_varid, tmp, start = start, & 33 | count = count) ) 34 | call check( nf90_get_var(ncid, sal_varid, sal, start, count) ) 35 | enddo 36 | 37 | ! (4) Close the file 38 | call check( nf90_close(ncid) ) 39 | write(*,*) "*** SUCCESS Reading file ", fname2, "!" 40 | 41 | tmp2 = tmp(sub_xy(1):sub_xy(3),sub_xy(2):sub_xy(4),:) 42 | sal2 = sal(sub_xy(1):sub_xy(3),sub_xy(2):sub_xy(4),:) 43 | 44 | return 45 | end subroutine readdata 46 | 47 | subroutine check(status) 48 | integer, intent (in) :: status 49 | 50 | if (status /= nf90_noerr) then 51 | print *, trim(nf90_strerror(status)) 52 | stop "Stopped" 53 | endif 54 | 55 | return 56 | end subroutine check 57 | 58 | end module mod_read_data 59 | -------------------------------------------------------------------------------- /Data Assimilation Code/output/README.txt: -------------------------------------------------------------------------------- 1 | background and analysis files will be saved here 2 | -------------------------------------------------------------------------------- /Matlab Code for Data Analysis/read_da_output.m: -------------------------------------------------------------------------------- 1 | clear; clc; 2 | 3 | ii = 443; jj = 511; kk = 50; % points in x (longitude), y (latitude), and z (depth) directions. 4 | 5 | %% open coordinate file for DA domain 6 | cd /home/c354chen/Documents/Research/DA_NEMO/DA_Argo 7 | load depth.txt 8 | fid = fopen('coordinate.dta','r','s'); 9 | bogus = fread(fid,1,'int32'); 10 | lons = fread(fid,[ii jj],'real*4','s'); 11 | lats = fread(fid,[ii jj],'real*4','s'); 12 | fclose(fid); 13 | 14 | %% read background or analysis 15 | fname = 'background.dta'; % fname = 'analysis.dta'; 16 | fid = fopen(fname,'r','s'); 17 | bogus = fread(fid,1,'int32'); 18 | T = fread(fid,[ii*jj*kk],'real*4','s'); % temperature 19 | S = fread(fid,[ii*jj*kk],'real*4','s'); % salinity 20 | fclose(fid); 21 | 22 | T = reshape(T,ii,jj,kk); T(T==0) = nan; 23 | S = reshape(S,ii,jj,kk); S(S==0) = nan; 24 | -------------------------------------------------------------------------------- /Readme.txt: -------------------------------------------------------------------------------- 1 | This project constructs an EnOI (Ensemble Optimal Interpolation) data assimilation model for ocean current forecasts. 2 | 3 | The model constructs the background file from the restart files; 4 | reads in observation; 5 | calculates W matrix for generating an analysis file; 6 | updates the restart files with the newly generated analysis file. 7 | 8 | Next, NEMO restarts with the updated restart files, and another cycle of data assimilation begins... 9 | --------------------------------------------------------------------------------