7 ki,pitm,psst,psic,htest)
39 USE modd_assim, ONLY : lecsst, lread_sst_from_file, cfile_format_sst, nprintlev
47 USE modi_init_io_surf_n
51 USE modi_end_io_surf_n
52 USE modi_io_buff_clean
55 USE yomhook
, ONLY : lhook,dr_hook
56 USE parkind1
, ONLY : jprb
69 INTEGER,
INTENT(IN) :: ki
70 REAL,
DIMENSION(KI),
INTENT(IN) :: pitm
71 REAL,
DIMENSION(KI),
INTENT(OUT) :: psst
72 REAL,
DIMENSION(KI),
INTENT(OUT) :: psic
73 CHARACTER(LEN=2),
INTENT(IN) :: htest
79 REAL,
ALLOCATABLE,
DIMENSION(:,:) :: zwork,zwork2
80 REAL,
ALLOCATABLE,
DIMENSION(:) :: zsea
81 CHARACTER(LEN=200) :: ymfile
82 CHARACTER(LEN=6) :: yprogram2 =
'FA '
83 REAL,
DIMENSION(SIZE(PSST)) :: zsst
84 REAL :: zfmax, zfmin, zfmean
85 INTEGER :: iresp,istat
87 REAL(KIND=JPRB) :: zhook_handle
89 IF (lhook) CALL dr_hook(
'ASSIM_SET_SST',0,zhook_handle)
92 CALL
abor1_sfx(
'ASSIM_SET_SST: FATAL ERROR DURING ARGUMENT TRANSFER')
95 IF (u%CSEA==
"NONE" .OR. u%NDIM_SEA == 0)
THEN
96 IF (lhook) CALL dr_hook(
'ASSIM_SET_SST_N',1,zhook_handle)
102 IF ( lread_sst_from_file )
THEN
104 IF ( trim(cfile_format_sst) ==
"ASCII" )
THEN
106 ALLOCATE(zsea(u%NDIM_FULL))
107 ALLOCATE(zwork(u%NDIM_FULL,2))
108 ALLOCATE(zwork2(u%NSIZE_FULL,2))
112 IF (nrank==npio)
THEN
114 IF (nprintlev > 0 .AND. nrank==npio ) &
115 WRITE(*,*)
"READING SST/SIC from file "//trim(ymfile)//
".DAT for ",&
116 u%NDIM_SEA,
" sea points",u%NDIM_FULL
118 OPEN(unit=55,file=trim(ymfile)//
".DAT",form=
'FORMATTED',status=
'OLD',iostat=istat)
119 IF ( istat /= 0 ) CALL
abor1_sfx(
"Can not open "//trim(ymfile))
123 DO ji = 1,u%NDIM_FULL
124 IF ( zsea(ji) > 0. )
THEN
125 READ (55,*,iostat=istat) (zwork(ji,jj),jj=1,2)
126 IF ( istat /= 0 ) CALL
abor1_sfx(
"Error reading file "//trim(ymfile))
141 DO ji = 1,u%NSIZE_FULL
142 psst(ji)=zwork2(ji,1)
143 psic(ji)=zwork2(ji,2)
150 ELSEIF ( trim(cfile_format_sst) ==
"FA" )
THEN
157 cfilein_fa =
'SST_SIC'
159 IF (nrank==npio .AND. nprintlev>0)
WRITE(*,*)
'READING SST FROM ',trim(cfilein_fa)
165 yprogram2,
'EXTZON',
'SURF ',
'READ ')
172 yprogram2,
'SURFSEA.TEMPERA',psst,iresp)
176 yprogram2,
'SURFTEMPERATURE',psst,iresp)
183 IF (nrank==npio)
WRITE(*,*)
'READ SST_SIC OK'
188 zfmean = sum(psst)/float(ki)
195 IF (nrank==npio .AND. nprintlev>0)
THEN
196 WRITE(*,*)
' ECMWF_SST_SIC'
197 WRITE(*,
'(" SURFSEA.TEMPERA - min, mean, max: ",3E13.4)') zfmin, zfmean, zfmax
201 WHERE ( psst(:)< 0. )
207 IF (nrank==npio .AND. nprintlev>0)
THEN
208 WRITE(*,*)
' Boundary file'
209 WRITE(*,
'(" SURFTEMPERATURE - min, mean, max: ",3E13.4)') zfmin, zfmean, zfmax
212 WHERE ( pitm(:)>0.5 )
221 zfmean = sum(psst)/float(ki)
226 IF (nrank==npio .AND. nprintlev>0)
THEN
227 WRITE(*,*)
' Replaced land by UNDEF '
228 WRITE(*,
'(" SST - min, mean, max: ",3E13.4)') zfmin, zfmean, zfmax
232 CALL
abor1_sfx(
"CFILE_FORMAT_SST="//trim(cfile_format_sst)//
" not implemented!")
237 IF ( u%NSIZE_SEA>0 .AND. u%CSEA/=
"NONE")
THEN
246 IF (lhook) CALL dr_hook(
'ASSIM_SET_SST',1,zhook_handle)
subroutine init_io_surf_n(DTCO, DGU, U, HPROGRAM, HMASK, HSCHEME, HACTION)
subroutine abor1_sfx(YTEXT)
subroutine end_io_surf_n(HPROGRAM)
subroutine assim_set_sst(DTCO, DGU, S, U, KI, PITM, PSST, PSIC, HTEST)