Changeset 11863 for branches/UKMO/dev_r5518_obs_oper_update_SlaAssim/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90
- Timestamp:
- 2019-11-05T18:22:07+01:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_obs_oper_update_SlaAssim/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90
r11468 r11863 167 167 & cn_slphynonfbfiles, & ! Surface non-diatom log10(phytoplankton carbon) input filenames 168 168 & cn_sspmfbfiles, & ! Surface suspended particulate matter input filenames 169 & cn_skd490fbfiles, & ! Surface Kd490 input filenames 169 170 & cn_sfco2fbfiles, & ! Surface fugacity of carbon dioxide input filenames 170 171 & cn_spco2fbfiles, & ! Surface partial pressure of carbon dioxide input filenames … … 203 204 LOGICAL :: ln_slphynon ! Logical switch for surface non-diatom log10(phytoplankton carbon) obs 204 205 LOGICAL :: ln_sspm ! Logical switch for surface suspended particulate matter obs 206 LOGICAL :: ln_skd490 ! Logical switch for surface Kd490 205 207 LOGICAL :: ln_sfco2 ! Logical switch for surface fugacity of carbon dioxide obs 206 208 LOGICAL :: ln_spco2 ! Logical switch for surface partial pressure of carbon dioxide obs … … 230 232 & clproffiles, & ! Profile filenames 231 233 & clsurffiles ! Surface filenames 234 CHARACTER(len=8), DIMENSION(:), ALLOCATABLE :: clvars ! Expected variable names 232 235 233 236 LOGICAL, DIMENSION(:), ALLOCATABLE :: llvar ! Logical for profile variable read … … 251 254 & ln_slphytot, ln_slphydia, ln_slphynon, & 252 255 & ln_sspm, ln_sfco2, ln_spco2, & 256 & ln_skd490, & 253 257 & ln_plchltot, ln_pchltot, ln_pno3, & 254 258 & ln_psi4, ln_ppo4, ln_pdic, & … … 270 274 & cn_slphytotfbfiles, cn_slphydiafbfiles, & 271 275 & cn_slphynonfbfiles, cn_sspmfbfiles, & 276 & cn_skd490fbfiles, & 272 277 & cn_sfco2fbfiles, cn_spco2fbfiles, & 273 278 & cn_plchltotfbfiles, cn_pchltotfbfiles, & … … 312 317 cn_slphynonfbfiles(:) = '' 313 318 cn_sspmfbfiles(:) = '' 319 cn_skd490fbfiles(:) = '' 314 320 cn_sfco2fbfiles(:) = '' 315 321 cn_spco2fbfiles(:) = '' … … 374 380 WRITE(numout,*) ' Logical switch for surface non-diatom log(phyC) obs ln_slphynon = ', ln_slphynon 375 381 WRITE(numout,*) ' Logical switch for surface SPM observations ln_sspm = ', ln_sspm 382 WRITE(numout,*) ' Logical switch for surface Kd490 observations ln_skd490 = ', ln_skd490 376 383 WRITE(numout,*) ' Logical switch for surface fCO2 observations ln_sfco2 = ', ln_sfco2 377 384 WRITE(numout,*) ' Logical switch for surface pCO2 observations ln_spco2 = ', ln_spco2 … … 433 440 & ln_slchlmic, ln_slchlnan, ln_slchlpic, ln_schltot, & 434 441 & ln_slphytot, ln_slphydia, ln_slphynon, ln_sspm, & 435 & ln_s fco2, ln_spco2 /) )442 & ln_skd490, ln_sfco2, ln_spco2 /) ) 436 443 437 444 IF ( nproftypes == 0 .AND. nsurftypes == 0 ) THEN … … 613 620 cobstypessurf(jtype) = 'sspm' 614 621 clsurffiles(jtype,:) = cn_sspmfbfiles 622 ENDIF 623 IF (ln_skd490) THEN 624 jtype = jtype + 1 625 cobstypessurf(jtype) = 'skd490' 626 clsurffiles(jtype,:) = cn_skd490fbfiles 615 627 ENDIF 616 628 IF (ln_sfco2) THEN … … 736 748 IF ( ln_output_clim ) ltype_clim = .TRUE. 737 749 ALLOCATE(llvar(nvarsprof(jtype))) 750 ALLOCATE(clvars(nvarsprof(jtype))) 738 751 CALL wrk_alloc( jpi, jpj, nvarsprof(jtype), zglam ) 739 752 CALL wrk_alloc( jpi, jpj, nvarsprof(jtype), zgphi ) … … 741 754 llvar(1) = ln_t3d 742 755 llvar(2) = ln_s3d 756 clvars(1) = 'POTM' 757 clvars(2) = 'PSAL' 743 758 zglam(:,:,1) = glamt(:,:) 744 759 zglam(:,:,2) = glamt(:,:) … … 751 766 nextrprof(jtype) = 2 752 767 ALLOCATE(llvar(nvarsprof(jtype))) 768 ALLOCATE(clvars(nvarsprof(jtype))) 753 769 CALL wrk_alloc( jpi, jpj, nvarsprof(jtype), zglam ) 754 770 CALL wrk_alloc( jpi, jpj, nvarsprof(jtype), zgphi ) … … 756 772 llvar(1) = ln_vel3d 757 773 llvar(2) = ln_vel3d 774 clvars(1) = 'UVEL' 775 clvars(2) = 'VVEL' 758 776 zglam(:,:,1) = glamu(:,:) 759 777 zglam(:,:,2) = glamv(:,:) … … 766 784 nextrprof(jtype) = 0 767 785 ALLOCATE(llvar(nvarsprof(jtype))) 786 ALLOCATE(clvars(nvarsprof(jtype))) 768 787 CALL wrk_alloc( jpi, jpj, nvarsprof(jtype), zglam ) 769 788 CALL wrk_alloc( jpi, jpj, nvarsprof(jtype), zgphi ) … … 773 792 zgphi(:,:,1) = gphit(:,:) 774 793 zmask(:,:,:,1) = tmask(:,:,:) 794 IF ( TRIM(cobstypesprof(jtype)) == 'plchltot' ) THEN 795 clvars(1) = 'PLCHLTOT' 796 ELSE IF ( TRIM(cobstypesprof(jtype)) == 'pchltot' ) THEN 797 clvars(1) = 'PCHLTOT' 798 ELSE IF ( TRIM(cobstypesprof(jtype)) == 'pno3' ) THEN 799 clvars(1) = 'PNO3' 800 ELSE IF ( TRIM(cobstypesprof(jtype)) == 'psi4' ) THEN 801 clvars(1) = 'PSI4' 802 ELSE IF ( TRIM(cobstypesprof(jtype)) == 'ppo4' ) THEN 803 clvars(1) = 'PPO4' 804 ELSE IF ( TRIM(cobstypesprof(jtype)) == 'pdic' ) THEN 805 clvars(1) = 'PDIC' 806 ELSE IF ( TRIM(cobstypesprof(jtype)) == 'palk' ) THEN 807 clvars(1) = 'PALK' 808 ELSE IF ( TRIM(cobstypesprof(jtype)) == 'pph' ) THEN 809 clvars(1) = 'PPH' 810 ELSE IF ( TRIM(cobstypesprof(jtype)) == 'po2' ) THEN 811 clvars(1) = 'PO2' 812 ENDIF 775 813 ENDIF 776 814 … … 780 818 & nvarsprof(jtype), nextrprof(jtype), nitend-nit000+2, & 781 819 & rn_dobsini, rn_dobsend, llvar, & 782 & ln_ignmis, ln_s_at_t, .FALSE., ltype_clim, &820 & ln_ignmis, ln_s_at_t, .FALSE., ltype_clim, clvars, & 783 821 & kdailyavtypes = nn_profdavtypes ) 784 822 … … 794 832 & kdailyavtypes = nn_profdavtypes ) 795 833 796 DEALLOCATE( llvar )834 DEALLOCATE( llvar, clvars ) 797 835 CALL wrk_dealloc( jpi, jpj, nvarsprof(jtype), zglam ) 798 836 CALL wrk_dealloc( jpi, jpj, nvarsprof(jtype), zgphi ) … … 814 852 DO jtype = 1, nsurftypes 815 853 816 nvarssurf(jtype) = 1817 nextrsurf(jtype) = 0818 854 ltype_clim = .FALSE. 819 IF ( TRIM(cobstypessurf(jtype)) == 'sla' ) nextrsurf(jtype) = 2820 855 IF ( ln_output_clim .AND. & 821 856 & ( ( TRIM(cobstypessurf(jtype)) == 'sst' ) .OR. & 822 857 & ( TRIM(cobstypessurf(jtype)) == 'sss' ) ) ) & 823 858 & ltype_clim = .TRUE. 859 860 IF ( TRIM(cobstypessurf(jtype)) == 'sla' ) THEN 861 nvarssurf(jtype) = 1 862 nextrsurf(jtype) = 2 863 ELSE 864 nvarssurf(jtype) = 1 865 nextrsurf(jtype) = 0 866 ENDIF 867 868 ALLOCATE( clvars( nvarssurf(jtype) ) ) 869 870 IF ( TRIM(cobstypessurf(jtype)) == 'sla' ) THEN 871 clvars(1) = 'SLA' 872 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'sst' ) THEN 873 clvars(1) = 'SST' 874 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'sic' ) THEN 875 clvars(1) = 'ICECONC' 876 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'sss' ) THEN 877 clvars(1) = 'SSS' 878 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'slchltot' ) THEN 879 clvars(1) = 'SLCHLTOT' 880 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'slchldia' ) THEN 881 clvars(1) = 'SLCHLDIA' 882 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'slchlnon' ) THEN 883 clvars(1) = 'SLCHLNON' 884 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'slchldin' ) THEN 885 clvars(1) = 'SLCHLDIN' 886 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'slchlmic' ) THEN 887 clvars(1) = 'SLCHLMIC' 888 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'slchlnan' ) THEN 889 clvars(1) = 'SLCHLNAN' 890 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'slchlpic' ) THEN 891 clvars(1) = 'SLCHLPIC' 892 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'schltot' ) THEN 893 clvars(1) = 'SCHLTOT' 894 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'slphytot' ) THEN 895 clvars(1) = 'SLPHYTOT' 896 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'slphydia' ) THEN 897 clvars(1) = 'SLPHYDIA' 898 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'slphynon' ) THEN 899 clvars(1) = 'SLPHYNON' 900 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'sspm' ) THEN 901 clvars(1) = 'SSPM' 902 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'skd490' ) THEN 903 clvars(1) = 'SKD490' 904 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'sfco2' ) THEN 905 clvars(1) = 'SFCO2' 906 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'spco2' ) THEN 907 clvars(1) = 'SPCO2' 908 ENDIF 824 909 825 910 !Read in surface obs types … … 828 913 & nvarssurf(jtype), nextrsurf(jtype), nitend-nit000+2, & 829 914 & rn_dobsini, rn_dobsend, ln_ignmis, .FALSE., & 830 & llnightav(jtype), ltype_clim )915 & llnightav(jtype), ltype_clim, clvars ) 831 916 832 917 CALL obs_pre_surf( surfdata(jtype), surfdataqc(jtype), ln_nea, ln_bound_reject ) … … 852 937 853 938 ENDIF 939 940 DEALLOCATE( clvars ) 854 941 855 942 END DO … … 963 1050 #if defined key_fabm 964 1051 REAL(wp), POINTER, DIMENSION(:,:,:) :: & 965 & pco2_3d ! 3D pCO2from FABM1052 & fabm_3d ! 3D variable from FABM 966 1053 #endif 967 1054 … … 1211 1298 CALL wrk_alloc( jpi, jpj, zsurfmask ) 1212 1299 #if defined key_fabm 1213 CALL wrk_alloc( jpi, jpj, jpk, pco2_3d )1300 CALL wrk_alloc( jpi, jpj, jpk, fabm_3d ) 1214 1301 #endif 1215 1302 … … 1444 1531 #endif 1445 1532 1533 CASE('skd490') 1534 #if defined key_hadocc 1535 CALL ctl_stop( ' Trying to run skd490 observation operator', & 1536 & ' but HadOCC does not explicitly simulate Kd490' ) 1537 #elif defined key_medusa 1538 CALL ctl_stop( ' Trying to run skd490 observation operator', & 1539 & ' but MEDUSA does not explicitly simulate Kd490' ) 1540 #elif defined key_fabm 1541 ! light_xEPS diagnostic variable 1542 fabm_3d(:,:,:) = fabm_get_interior_diagnostic_data(model, jp_fabm_xeps) 1543 zsurfvar(:,:) = fabm_3d(:,:,1) 1544 #else 1545 CALL ctl_stop( ' Trying to run skd490 observation operator', & 1546 & ' but no biogeochemical model appears to have been defined' ) 1547 #endif 1548 1446 1549 CASE('sfco2') 1447 1550 #if defined key_hadocc … … 1458 1561 #elif defined key_fabm 1459 1562 ! First, get pCO2 from FABM 1460 pco2_3d(:,:,:) = fabm_get_interior_diagnostic_data(model, jp_fabm_o3pc)1461 zsurfvar(:,:) = pco2_3d(:,:,1)1563 fabm_3d(:,:,:) = fabm_get_interior_diagnostic_data(model, jp_fabm_o3pc) 1564 zsurfvar(:,:) = fabm_3d(:,:,1) 1462 1565 ! Now, convert pCO2 to fCO2, based on SST in K. This follows the standard methodology of: 1463 1566 ! Pierrot et al. (2009), Recommendations for autonomous underway pCO2 measuring systems … … 1497 1600 zsurfvar(:,:) = f2_pco2w(:,:) 1498 1601 #elif defined key_fabm 1499 pco2_3d(:,:,:) = fabm_get_interior_diagnostic_data(model, jp_fabm_o3pc)1500 zsurfvar(:,:) = pco2_3d(:,:,1)1602 fabm_3d(:,:,:) = fabm_get_interior_diagnostic_data(model, jp_fabm_o3pc) 1603 zsurfvar(:,:) = fabm_3d(:,:,1) 1501 1604 #else 1502 1605 CALL ctl_stop( ' Trying to run spco2 observation operator', & … … 1533 1636 CALL wrk_dealloc( jpi, jpj, zsurfmask ) 1534 1637 #if defined key_fabm 1535 CALL wrk_dealloc( jpi, jpj, jpk, pco2_3d )1638 CALL wrk_dealloc( jpi, jpj, jpk, fabm_3d ) 1536 1639 #endif 1537 1640
Note: See TracChangeset
for help on using the changeset viewer.